---
title: "When Is It Fair to Tax the Rich? The Importance of Pro-Social Behavior"
subtitle: "Online Appendix"
author: "Kris-Stella Trump"
thanks: "Author affiliation: Johns Hopkins University. Contact: kstrump@jhu.edu"
header-includes:
   - \usepackage{setspace}\doublespacing
   - \setlength\parindent{24pt}
   - \usepackage{pdflscape}
   - \newcommand{\blandscape}{\begin{landscape}}
   - \newcommand{\elandscape}{\end{landscape}}
   - \def\UrlBreaks{\do\/\do-\do?\do.}
output: 
  pdf_document:
    number_sections: false
    fig_caption: yes
    toc: true
fontsize: 12pt
bibliography: taxtherich.bib 
---

```{r setup, include=F, warning=F}
# r version 4.4.1
# all packages updated on 02 October 2024
# cregg has been archived from cran; version 4.0 installed from source https://cran.r-project.org/src/contrib/Archive/cregg/

library(tidyverse)
library(qualtRics)
library(ggplot2)
library(RColorBrewer)
library(pander)
library(haven)
library(cregg)
library(ggpubr)
library(kableExtra)
library(patchwork)


here::i_am("Tax the rich appendix.Rmd")
library(here)

knitr::opts_chunk$set(echo = FALSE)
options(digits=2, scipen=999)
panderOptions('round', 0) #sets decimals
#panderOptions('digits', 2) #sets significant digits
panderOptions('keep.trailing.zeros', TRUE)
```

```{r study1 data prep, include=FALSE, message=F, warning=F}
#read in data
study1 <- read.csv(here("Study 1", "Study 1 data.csv"))

#recode data for analysis. 
study1 <- study1 %>% 
  mutate(
    redistr_agree = 6 - redistr_agree,
    tax_highinc_agree = 6 - tax_highinc_agree,
    redistr_fair = replace(redistr_fair, redistr_fair==5, 4), #needed to fix a mistake in the qualtrics numeric codes assigned to downloaded responses, which can also be seen in codebook
    redistr_fair = replace(redistr_fair, redistr_fair==6, 5),
    redistr_fair = 6 - redistr_fair,
    tax_highinc_fair = 6 - tax_highinc_fair,
    getahead = 6 - getahead,
    rr = (((6-rr_1) + rr_2 + rr_3 + (6-rr_4))-4)/16,
    male = gender==1,
    age = 2020-year_born,
    multiracial = str_length(race>1),
    white = race==1,
    black = race==2,
    hispanic = hispanic==1,
    south = state==(45|37|4|19|25|1|44|18|50|21|9|8|48|34|42|11|10),
    married = marital==1,
    dem_lean = replace_na(dem_lean, 0),
    rep_lean = replace_na(rep_lean, 0),
    indep_lean = replace_na(indep_lean,0),
    partisan_republican = 1*(dem_lean==1) + 2*(dem_lean==2) + 3*(indep_lean==3) + 4*(indep_lean==4) + 5*(indep_lean==5) + 6*(rep_lean==6) + 7*(rep_lean==7),
    partisan_republican = replace(partisan_republican, partisan_republican==0, NA),
    college = educ>3,
    hh_income_thou = recode(hh_inc, `1`=5, `2`=15, `3`=25, `4`=35, `5`=45, `6`=55, `7`=65, `8`=75, `9`=85, `10`=95, `11`=125, `12`=175),
    open_fairshare = ifelse(fairshare_open=="", 0, 1),
    open_rich = ifelse(deserve_open=="" & undeserve_open=="", 0,1)
  )


#prepare for when rich analysis: top coding
study1 <- study1 %>% 
  mutate(inc_rich_clean = as.numeric(inc_rich_clean),
    inc_rich_trunc = ifelse(inc_rich_clean>=1000000,1000000,inc_rich_clean))

#separate out partisans incl leaners
dems <- study1 %>% 
  filter(partisan_republican<4)
reps <- study1 %>% 
  filter(partisan_republican>4)
```

```{r data prep pilot experiment, include=F, warning=F}
#read in data
prolific <- read.csv(here("Pilot experiment", "Pilot experiment data.csv"))

#recode data for analysis. 
prolific <- prolific %>% 
  mutate(
    rr = ((rr_1 + (6-rr_2) + (6-rr_3) + rr_4)-4)/16,
    male = gender==1,
    age = 2020-year_born,
    multiracial = str_length(race>1),
    white = race==1,
    black = race==2,
    hispanic = hispanic==1,
    south = state==(45|37|4|19|25|1|44|18|50|21|9|8|48|34|42|11|10),
    married = marital==1,
    dem_lean = replace_na(dem_lean, 0),
    rep_lean = replace_na(rep_lean, 0),
    indep_lean = replace_na(indep_lean,0),
    partisan_republican = 1*(dem_lean==1) + 2*(dem_lean==2) + 3*(indep_lean==2) + 4*(indep_lean==3) + 5*(indep_lean==1) + 6*(rep_lean==2) + 7*(rep_lean==1),
    college = educ>3,
    hh_income_thou = recode(hh_inc, `1`=5, `2`=15, `3`=25, `4`=35, `5`=45, `6`=55, `7`=65, `8`=75, `9`=85, `10`=95, `11`=125, `12`=175),
    Partisanship = ifelse(partisan_republican < 4, "Democrat", ifelse(partisan_republican > 4, "Republican", NA))
  )

#reformat data for conjoint analysis - task-based 
respondents <- prolific %>%
  select(-starts_with("vig"))

vig1_vars <- prolific %>% 
  select(starts_with("vig1"), resp_id) %>%
  rename_all(
    funs(
      stringr::str_replace_all(., 'vig1','vig')
    )
  ) %>%
  mutate(vig_app = 1) %>% 
  left_join(.,respondents, by="resp_id")

vig2_vars <- prolific %>% 
  select(starts_with("vig2"), resp_id) %>%
  rename_all(
    funs(
      stringr::str_replace_all(., 'vig2','vig')
    )
  ) %>%
  mutate(vig_app = 2) %>% 
  left_join(.,respondents, by="resp_id")

vig3_vars <- prolific %>% 
  select(starts_with("vig3"), resp_id) %>%
  rename_all(
    funs(
      stringr::str_replace_all(., 'vig3','vig')
    )
  ) %>%
  mutate(vig_app = 3) %>% 
  left_join(.,respondents, by="resp_id")

vig_data_prolific <- bind_rows(vig1_vars, vig2_vars, vig3_vars)

#change responses to factors
vig_data_prolific <- vig_data_prolific %>% 
  mutate(vig_genderv = as_factor(ifelse(vig_genderv=="he", "Male", "Female")),
         vig_income_dollar = as_factor(vig_income_dollar),
         vig_income_percentile = as_factor(vig_income_percentile),
         vig_wealth_source = as_factor(ifelse(vig_wealth_source=="a good job gotten through family connections", "Family connections", ifelse(vig_wealth_source=="a large inheritance", "Inheritance", "Built a company"))),
         vig_hard_work = as_factor(ifelse(vig_hard_work=="known as a hard worker who always puts in the effort", "Works hard", "Does not work hard")),
         vig_treat_workers = as_factor(ifelse(vig_treat_workers=="treating workers fairly and paying them a good wage", "Fairly", "Unfairly")),
         vig_loopholes = as_factor(ifelse(vig_loopholes=="to avoid making use of tax loopholes, and to just pay the tax rates as they are", "Does not use loopholes", "Uses loopholes")),
         vig_charity = as_factor(ifelse(vig_charity=="does not give money to charities", "Does not donate", "Donates")),
         vig_consumption = as_factor(ifelse(vig_consumption=="a habit of buying expensive and flashy things", "Conspicuous", "Modest")),
         Partisanship = as_factor(Partisanship)
  )

#formula for estimating amces
f1 <- vig_tax ~ vig_genderv + vig_income_dollar + vig_wealth_source + vig_hard_work + vig_treat_workers + vig_loopholes + vig_charity + vig_consumption

#relevel to get desired reference categories
vig_data_prolific <- vig_data_prolific %>%
  mutate(vig_genderv = relevel(vig_genderv, ref="Female"),
         vig_charity = relevel(vig_charity, ref="Donates"),
         vig_wealth_source = relevel(vig_wealth_source, ref = "Built a company"),
         vig_hard_work = relevel(vig_hard_work, ref = "Works hard")
         )

#relabel variables for better plot display
attr(vig_data_prolific$vig_genderv, "label") <- "Gender"
attr(vig_data_prolific$vig_income_dollar, "label") <- "Household income"
attr(vig_data_prolific$vig_income_percentile, "label") <- "Income percentile"
attr(vig_data_prolific$vig_wealth_source, "label") <- "Source of wealth"
attr(vig_data_prolific$vig_hard_work, "label") <- "Work ethic"
attr(vig_data_prolific$vig_treat_workers, "label") <- "Treats workers"
attr(vig_data_prolific$vig_loopholes, "label") <- "Loopholes"
attr(vig_data_prolific$vig_charity, "label") <- "Charity"
attr(vig_data_prolific$vig_consumption, "label") <- "Consumption"

#estimate
amces_prolific <- cj(vig_data_prolific, f1, id = ~ resp_id)%>%
  filter(feature!="Gender")
mms_prolific <- mm(vig_data_prolific, f1, id = ~ resp_id)%>%
  filter(feature!="Gender")

# data prep for anova
vig_data_prolific_subset <- vig_data_prolific[ , c("Partisanship")] 
vig_data_prolific_complete <- vig_data_prolific[complete.cases(vig_data_prolific_subset), ]

#relabel variables for better plot display
attr(vig_data_prolific_complete$vig_genderv, "label") <- "Gender"
attr(vig_data_prolific_complete$vig_income_dollar, "label") <- "Household income"
attr(vig_data_prolific_complete$vig_income_percentile, "label") <- "Income percentile"
attr(vig_data_prolific_complete$vig_wealth_source, "label") <- "Source of wealth"
attr(vig_data_prolific_complete$vig_hard_work, "label") <- "Work ethic"
attr(vig_data_prolific_complete$vig_treat_workers, "label") <- "Treats workers"
attr(vig_data_prolific_complete$vig_loopholes, "label") <- "Loopholes"
attr(vig_data_prolific_complete$vig_charity, "label") <- "Charity"
attr(vig_data_prolific_complete$vig_consumption, "label") <- "Consumption"

# calculate conditional MMs
mms_cond_prolific <- cj(vig_data_prolific_complete, 
          f1,
          id = ~ resp_id, 
          estimate = "mm", 
          by = ~ Partisanship) %>%
  filter(feature!="Gender")
diff_mms_cond_prolific <- cj(vig_data_prolific_complete, 
          f1,
          id = ~ resp_id, 
          estimate = "mm_diff", 
          by = ~ Partisanship) %>%
  filter(feature!="Gender")

# calculate conditional amces
amces_cond_prolific <- cj(vig_data_prolific_complete, 
          f1,
          id = ~ resp_id, 
          estimate = "amce", 
          by = ~ Partisanship) %>%
  filter(feature!="Gender")
diff_amces_cond_prolific <- cj(vig_data_prolific_complete, 
          f1,
          id = ~ resp_id, 
          estimate = "amce_diff", 
          by = ~ Partisanship) %>%
  filter(feature!="Gender")
## create plots etc

amces_plot_prolific <- plot(amces_prolific, legend_title=NULL, legend_pos="none")
mms_plot_prolific <- plot(mms_prolific, vline = mean(vig_data_prolific$vig_tax), legend_title=NULL, legend_pos="none")
amces_mms_plot_prolific <- ggarrange(amces_plot_prolific, mms_plot_prolific)  + 
  plot_annotation(title="Support for taxing rich target", subtitle="Experimental results by target attributes, pilot study in US") &
  theme(plot.title = element_text(hjust = 0.5), plot.subtitle = element_text(hjust=0.5))

amce_interactions_plot_prolific <- plot(rbind(amces_cond_prolific, diff_amces_cond_prolific), legend_title=NULL, legend_pos="none") + ggplot2::facet_wrap(~BY, ncol = 3L) + 
  plot_annotation(title="Support for taxing rich target", subtitle="Experimental results by target attributes and respondent partisnship, pilot study in US") &
  theme(plot.title = element_text(hjust = 0.5), plot.subtitle = element_text(hjust=0.5))

mm_by_prolific <- cj(vig_data_prolific, f1, id = ~ resp_id, estimate = "mm", by = ~ Partisanship) %>%
  filter(feature!="Gender")
mm_by_prolific_plot <- plot(mm_by_prolific, group = "Partisanship", vline = mean(vig_data_prolific$vig_tax)) + 
  plot_annotation(title="Support for taxing rich target", subtitle="Marginal means by target attributes and respondent partisanship, pilot study in US") &
  theme(plot.title = element_text(hjust = 0.5), plot.subtitle = element_text(hjust=0.5))

```

```{r data prep for analysis of US/Lucid conjoint, include=F, warning=FALSE}
#read in data
lucid_raw <- read_survey(here("Study 2", "Study 2 data.csv"))

#recode data for analysis. 
lucid <- lucid_raw %>% 
  rename(vig1_gender = gender_reg_1,
         vig1_income = income_1,
         vig1_family_bgr = family_bgr_1,
         vig1_hard_work = hard_work_1,
         vig1_treat_workers = treat_workers_1,
         vig1_loopholes = loopholes3_1,
         vig1_charity = charity_1,
         vig1_consumption = consumption_1,
         vig2_gender = gender_reg_2,
         vig2_income = income_2,
         vig2_family_bgr = family_bgr_2,
         vig2_hard_work = hard_work_2,
         vig2_treat_workers = treat_workers_2,
         vig2_loopholes = loopholes3_2,
         vig2_charity = charity_2,
         vig2_consumption = consumption_2,         
         vig3_gender = gender_reg_3,
         vig3_income = income_3,
         vig3_family_bgr = family_bgr_3,
         vig3_hard_work = hard_work_3,
         vig3_treat_workers = treat_workers_3,
         vig3_loopholes = loopholes3_3,
         vig3_charity = charity_3,
         vig3_consumption = consumption_3,
         ) %>%
  select(-gender_poss_1, -gender_obj_1, -gender_cap_1, -loopholes0_1, -loopholes1_1, -loopholes2_1,-gender_poss_2, -gender_obj_2, -gender_cap_2, -loopholes0_2, -loopholes1_2, -loopholes2_2, -gender_poss_3, -gender_obj_3, -gender_cap_3, -loopholes0_3, -loopholes1_3, -loopholes2_3) %>%
  mutate(
    rr = (((6-rr_1) + rr_2 + rr_3 + (6-rr_4))-4)/16,
    male = gender_lucid==1,
    age_q = 2020-year_born,
    white_lucid = ethnicity_lucid==1,
    black_lucid = ethnicity_lucid==2,
    hispanic_lucid_dummy = hispanic_lucid!=1 & hispanic_lucid!=15,
    multiracial_q = str_length(race>1),
    white_q = race==1,
    black_q = race==2,
    hispanic_q = hispanic==1,
    south_q = state==(45|37|4|19|25|1|44|18|50|21|9|8|48|34|42|11|10),
    south_lucid = region_lucid==3,
    married = marital==1,
    republican_lucid = political_party_lucid==2,
    democrat_lucid = political_party_lucid==1,
    dem_lean = replace_na(dem_lean, 0),
    rep_lean = replace_na(rep_lean, 0),
    indep_lean = replace_na(indep_lean,0),
    partisan_republican_q = 1*(dem_lean==1) + 2*(dem_lean==2) + 3*(indep_lean==2) + 4*(indep_lean==3) + 5*(indep_lean==1) + 6*(rep_lean==2) + 7*(rep_lean==1),
    college_lucid = education_lucid>7 & education_lucid<12,
    college_q = educ>3,
    hh_income_thou_q = recode(hh_inc, `1`=5, `2`=15, `3`=25, `4`=35, `5`=45, `6`=55, `7`=65, `8`=75, `9`=85, `10`=95, `11`=125, `12`=175),
    hh_income_thou_lucid = recode(hhi_lucid, `1`=7.5, `2`=17.5, `3`=22.5, `4`=27.5, `5`=32.5, `6`=37.5, `7`=42.5, `8`=47.5, `9`=52.5, `10`=57.5, `11`=62.5, `12`=67.5, `13`=72.5, `14`=77.5, `15`=82.5, `16`=87.5, `17`=02.5, `18`=97.5, `19`=112.5, `20`=137.5, `21`=162.5, `22`=187.5, `23`=225, `24`=275),
    hh_income_above_median = ifelse(hh_income_thou_q>median(hh_income_thou_q, na.rm=T), "Above Median", ifelse(is.na(hh_income_thou_q), NA, "Below median")),
    partisanship_q_dummy = ifelse(partisan_republican_q < 4, "Democrat", ifelse(partisan_republican_q > 4, "Republican", NA))
  )

#screeners and exclusions
sum(lucid$Q_TerminateFlag=="Screened", na.rm = T)
lucid <- lucid %>% mutate(screened = ifelse(Q_TerminateFlag=="Screened", 1,0),
                          screened = replace_na(screened,0))
sum(lucid$screened==1)/nrow(lucid)
#38% screened out

#filter, keeping those who passed the screeners
#also filter out observations where lucid income measure did not come through - these should be excluded because they were also not used for balancing the final sample
lucid <- lucid %>% filter(screened!=1) %>%
  filter(is.na(hhi_lucid)!=1)

#how many finished
sum(lucid$Finished==1 & lucid$screened==0) #1825 completions
sum(lucid$Finished==0 & lucid$screened==0) #220 dropped out after passing screener
#lucid also does not use partial completions for demographic balancing - exclude partials here
lucid <- lucid %>% filter(Finished==1)


# reformat for conjoint analysis
#reformat data for conjoint analysis - task-based 
respondents <- lucid %>%
  select(-starts_with("vig"))

vig1_vars <- lucid %>% 
  select(starts_with("vig1"), resp_id) %>%
  rename_all(
    funs(
      stringr::str_replace_all(., 'vig1','vig')
    )
  ) %>%
  mutate(vig_number = 1) %>% 
  left_join(.,respondents, by="resp_id")

vig2_vars <- lucid %>% 
  select(starts_with("vig2"), resp_id) %>%
  rename_all(
    funs(
      stringr::str_replace_all(., 'vig2','vig')
    )
  ) %>%
  mutate(vig_number = 2) %>% 
  left_join(.,respondents, by="resp_id")

vig3_vars <- lucid %>% 
  select(starts_with("vig3"), resp_id) %>%
  rename_all(
    funs(
      stringr::str_replace_all(., 'vig3','vig')
    )
  ) %>%
  mutate(vig_number = 3) %>% 
  left_join(.,respondents, by="resp_id")

vig_data_lucid <- bind_rows(vig1_vars, vig2_vars, vig3_vars)
rm(vig1_vars, vig2_vars, vig3_vars)

#change responses to factors
vig_data_lucid <- vig_data_lucid %>% 
  mutate(vig_gender = as_factor(ifelse(vig_gender=="he", "Male", "Female")),
         vig_income = as_factor(ifelse(vig_income=="$500,000, which is more than what 99 out of 100 American households earn", "$500,000", "$250,000")),
         vig_family_bgr = as_factor(ifelse(vig_family_bgr=="a well-off family, and inherited a large amount of money", "Well-off", "Modest")),
         vig_hard_work = as_factor(ifelse(vig_hard_work=="known as someone who works hard and always puts in the effort", "Works hard", "Does not work hard")),
         vig_treat_workers = as_factor(ifelse(vig_treat_workers=="treating workers fairly and paying them a good wage", "Fairly", "Unfairly")),
         vig_loopholes = as_factor(ifelse(vig_loopholes=="chooses not to do this and just pays the tax rates as they are", "Does not use loopholes", "Uses loopholes")),
         vig_charity = as_factor(ifelse(vig_charity=="does not give money to charities", "Does not donate", "Donates")),
         vig_consumption = as_factor(ifelse(vig_consumption=="a habit of buying expensive and flashy things", "Conspicuous", "Not conspicuous")),
         Partisanship = as_factor(partisanship_q_dummy),
         Income = as_factor(hh_income_above_median)
  )


#relevel to get desired reference categories
vig_data_lucid <- vig_data_lucid %>%
  mutate(vig_gender = relevel(vig_gender, ref="Female"),
         vig_income = relevel(vig_income, ref="$250,000"),
         vig_charity = relevel(vig_charity, ref="Donates"),
         vig_family_bgr = relevel(vig_family_bgr, ref = "Modest"),
         vig_hard_work = relevel(vig_hard_work, ref = "Works hard"),
         vig_loopholes = relevel(vig_loopholes, ref="Does not use loopholes"),
         vig_consumption = relevel(vig_consumption, ref="Not conspicuous"),
         Partisanship = relevel(Partisanship, ref="Republican"),
         Income = relevel(Income, ref="Below median")
         )

#relabel variables for better plot display
attr(vig_data_lucid$vig_gender, "label") <- "Gender"
attr(vig_data_lucid$vig_income, "label") <- "Household income"
attr(vig_data_lucid$vig_family_bgr, "label") <- "Family bgr"
attr(vig_data_lucid$vig_hard_work, "label") <- "Work ethic"
attr(vig_data_lucid$vig_treat_workers, "label") <- "Treats workers"
attr(vig_data_lucid$vig_loopholes, "label") <- "Loopholes"
attr(vig_data_lucid$vig_charity, "label") <- "Charity"
attr(vig_data_lucid$vig_consumption, "label") <- "Consumption"
attr(vig_data_lucid$Income, "label") <- "Household Income"

#formula for estimating amces
f1 <- vig_tax ~ vig_gender + vig_income + vig_family_bgr + vig_hard_work + vig_treat_workers + vig_loopholes + vig_charity + vig_consumption

#estimate basic amce and then omit gender for presentation
amces_lucid <- cj(vig_data_lucid, f1, id = ~ resp_id) %>%
  filter(feature!="Gender")
mms_lucid <- mm(vig_data_lucid, f1, id = ~ resp_id) %>%
  filter(feature!="Gender")

#as per pre-registration double-check work ethic impact: subset to only wealthy background 
vig_data_lucid_wealthy <- vig_data_lucid %>%
  filter(vig_family_bgr=="Well-off")
#estimate effect only among the subset of vignettes with well-off family backgrounds
f2 <- vig_tax ~ vig_gender + vig_income + vig_hard_work + vig_treat_workers + vig_loopholes + vig_charity + vig_consumption
amces_wealthy_lucid <- cj(vig_data_lucid_wealthy, f2, id = ~ resp_id) %>%
  filter(feature!="Gender")
mms_wealthy_lucid <- mm(vig_data_lucid_wealthy, f2, id = ~ resp_id) %>%
  filter(feature!="Gender")

#partisanship
# data prep for anova by partisanship
vig_data_subset_lucid <- vig_data_lucid[ , c("Partisanship")] 
vig_data_complete_lucid <- vig_data_lucid[complete.cases(vig_data_subset_lucid), ]

# calculate conditional MMs
mms_cond_lucid <- cj(vig_data_complete_lucid, 
          f1,
          id = ~ resp_id, 
          estimate = "mm", 
          by = ~ Partisanship)  %>%
  filter(feature!="Gender")
diff_mms_cond_lucid <- cj(vig_data_complete_lucid, 
          f1,
          id = ~ resp_id, 
          estimate = "mm_diff", 
          by = ~ Partisanship)  %>%
  filter(feature!="Gender")

# calculate conditional amces by partisanship
amces_cond_lucid <- cj(vig_data_complete_lucid, 
          f1,
          id = ~ resp_id, 
          estimate = "amce", 
          by = ~ Partisanship)  %>%
  filter(feature!="Gender")
diff_amces_cond_lucid <- cj(vig_data_complete_lucid, 
          f1,
          id = ~ resp_id, 
          estimate = "amce_diff", 
          by = ~ Partisanship)  %>%
  filter(feature!="Gender")

#prepare plots with sample-specific names so they can be used even after DK data has been read in (NB some object names will get over-written)
amces_plot_lucid <- plot(amces_lucid, legend_title=NULL, legend_pos="none")
mms_plot_lucid <- plot(mms_lucid, vline = mean(vig_data_lucid$vig_tax, na.rm=T), legend_title=NULL, legend_pos="none")

#another version for comparison between US and Denmark
mms_plot_lucid_comp <- plot(mms_lucid, vline = mean(vig_data_lucid$vig_tax, na.rm=T), legend_title=NULL, legend_pos="none", xlim=c(3,3.8)) + ggtitle("United States")

#combine plots into one
amces_mms_plot_lucid <- (amces_plot_lucid + mms_plot_lucid) + 
  plot_annotation(title="Support for taxing rich target", subtitle="Experimental results by target attributes, United States sample") &
  theme(plot.title = element_text(hjust = 0.5), plot.subtitle = element_text(hjust=0.5))

#subset to wealthy targets only
amces_wealthy_plot_lucid <- plot(amces_wealthy_lucid, legend_title=NULL, legend_pos="none") + ggtitle("United States")

#plot results by partisanship
mm_by_lucid <- cj(vig_data_lucid, f1, id = ~ resp_id, estimate = "mm", by = ~ Partisanship) %>%
  filter(feature!="Gender")
mm_byparty_plot_us <- plot(mm_by_lucid, group = "Partisanship", xlim=c(2.8,3.9), legend_title=NULL) + 
  plot_annotation(title="Support for taxing rich target", subtitle="Marginal means by target attributes and respondent partisanship, United States") &
  theme(plot.title = element_text(hjust = 0.5), plot.subtitle = element_text(hjust=0.5))

amce_interactions_plot_lucid <- plot(rbind(amces_cond_lucid, diff_amces_cond_lucid), legend_title=NULL, legend_pos="none") + ggplot2::facet_wrap(~BY, ncol = 3L) + 
  plot_annotation(title="Support for taxing rich target", subtitle="Experimental results by target attributes and respondent partisanship, United States sample") &
  theme(plot.title = element_text(hjust = 0.5), plot.subtitle = element_text(hjust=0.5))


#by respondent income 
# calculate conditional amces by income
amces_inc_lucid <- cj(vig_data_complete_lucid, 
          f1,
          id = ~ resp_id, 
          estimate = "amce", 
          by = ~ Income)  %>%
  filter(feature!="Gender")
diff_amces_inc_lucid <- cj(vig_data_complete_lucid, 
          f1,
          id = ~ resp_id, 
          estimate = "amce_diff", 
          by = ~ Income)  %>%
  filter(feature!="Gender")

#plot results by income
amce_interactions_inc_plot_lucid <- plot(rbind(amces_inc_lucid, diff_amces_inc_lucid), legend_title=NULL, legend_pos="none") + ggplot2::facet_wrap(~BY, ncol = 3L)  + 
  plot_annotation(title="Support for taxing rich target", subtitle="Results by target attributes and respondent's household income, United States sample") &
  theme(plot.title = element_text(hjust = 0.5), plot.subtitle = element_text(hjust=0.5))

```

```{r data prep for DK / yougov analysis, include=F, warning=FALSE}
#read in data
yougov_raw <- read_dta(here("Study 3", "Study 3 data.dta"))

#recode data for analysis. 
yougov <- yougov_raw %>% 
  zap_labels(.) %>%
  rename(ResponseId = caseid,
         vig1_gender = q_gender_scr1,
         vig1_income = q_income_scr1,
         vig1_family_bgr = q_famback_scr1,
         vig1_hard_work = q_workethic_scr1,
         vig1_treat_workers = q_treatworkers_scr1,
         vig1_loopholes = q_useloopholes_scr1,
         vig1_charity = q_charitgiving_scr1,
         vig1_consumption = q_conspconsump_scr1,
         vig2_gender = q_gender_scr2,
         vig2_income = q_income_scr2,
         vig2_family_bgr = q_famback_scr2,
         vig2_hard_work = q_workethic_scr2,
         vig2_treat_workers = q_treatworkers_scr2,
         vig2_loopholes = q_useloopholes_scr2,
         vig2_charity = q_charitgiving_scr2,
         vig2_consumption = q_conspconsump_scr2,         
         vig3_gender = q_gender_scr3,
         vig3_income = q_income_scr3,
         vig3_family_bgr = q_famback_scr3,
         vig3_hard_work = q_workethic_scr3,
         vig3_treat_workers = q_treatworkers_scr3,
         vig3_loopholes = q_useloopholes_scr3,
         vig3_charity = q_charitgiving_scr3,
         vig3_consumption = q_conspconsump_scr3,
         vig1_tax = q3a,
         vig2_tax = q3b,
         vig3_tax = q3c,
         vig_open = q4
         ) %>%
  mutate(
    vig1_loopholes = recode(vig1_loopholes, `1`=1, `2`=2,`3`=1,`4`=2),
    vig2_loopholes = recode(vig2_loopholes, `1`=1, `2`=2,`3`=1,`4`=2),
    vig3_loopholes = recode(vig3_loopholes, `1`=1, `2`=2,`3`=1,`4`=2),
    redistr_agree = 6-q5_1,
    tax_highinc_agree = 6-q5_2,
    attention_pass = q5_3==2,
    decrease_spend = 6 - q5_4,
    getahead_aveperson = 6-q6,
    getahead_hw = 4-q7,
    migration_econ_good = q8,
    migration_culture_good = q9,
    migration_good = q10,
    foreignborn = q11==2,
    male = gender_rc==2,
    age_group = profile_age2,
    education = ifelse(profile_education<9, profile_education, NA),
    household_income = ifelse(household_income<12, household_income, NA),
    hh_income_tenthou = recode(household_income, `1`=5, `2`=15, `3`=25, `4`=35, `5`=45, `6`=55, `7`=65,`8`=75, `9`=85, `10`=95, `11`=105),
    hh_income_above_median = ifelse(hh_income_tenthou>median(hh_income_tenthou, na.rm=T), "Above Median", ifelse(is.na(hh_income_tenthou), NA, "Below median")),
    personal_income = ifelse(personal_income<12, personal_income, NA),
    pers_income_tenthou = recode(personal_income, `1`=5, `2`=15, `3`=25, `4`=35, `5`=45, `6`=55, `7`=65,`8`=75, `9`=85, `10`=95, `11`=105),
    partisanship_right = ifelse(political_viewpoint<6, 6-political_viewpoint, NA),
    partisanship_right_dummy = (ifelse(political_viewpoint==6 | political_viewpoint==3, NA, ifelse(political_viewpoint<3, 1,0))),
    screened = status==2
  ) %>% 
  select(-q_useloopholes2_scr1, -q_useloopholes1_scr1, -q_useloopholes2_scr2, -q_useloopholes1_scr2, -q_useloopholes2_scr3, -q_useloopholes1_scr3)

#screeners and exclusions
sum(yougov$screened==1)/nrow(yougov)
#38% screened out

#filter, keeping those who passed the screeners
yougov <- yougov %>% filter(screened!=1)

# reformat for conjoint analysis
#reformat data for conjoint analysis - task-based 
respondents <- yougov %>%
  select(-starts_with("vig"))

vig1_vars <- yougov %>% 
  select(starts_with("vig1"), ResponseId) %>%
  rename_all(
    funs(
      stringr::str_replace_all(., 'vig1','vig')
    )
  ) %>%
  mutate(vig_number = 1) %>% 
  left_join(.,respondents, by="ResponseId")

vig2_vars <- yougov %>% 
  select(starts_with("vig2"), ResponseId) %>%
  rename_all(
    funs(
      stringr::str_replace_all(., 'vig2','vig')
    )
  ) %>%
  mutate(vig_number = 2) %>% 
  left_join(.,respondents, by="ResponseId")

vig3_vars <- yougov %>% 
  select(starts_with("vig3"), ResponseId) %>%
  rename_all(
    funs(
      stringr::str_replace_all(., 'vig3','vig')
    )
  ) %>%
  mutate(vig_number = 3) %>% 
  left_join(.,respondents, by="ResponseId")

vig_data_yougov <- bind_rows(vig1_vars, vig2_vars, vig3_vars)
rm(vig1_vars, vig2_vars, vig3_vars)

#change responses to factors
vig_data_yougov <- vig_data_yougov %>% 
  mutate(vig_gender = as_factor(ifelse(vig_gender==1, "Male", "Female")),
         vig_income = as_factor(ifelse(vig_income==1, "DKK 50,000", "DKK 130,000")),
         vig_family_bgr = as_factor(ifelse(vig_family_bgr==2, "Well-off", "Modest")),
         vig_hard_work = as_factor(ifelse(vig_hard_work==1, "Works hard", "Does not work hard")),
         vig_treat_workers = as_factor(ifelse(vig_treat_workers==1, "Fairly", "Unfairly")),
         vig_loopholes = as_factor(ifelse(vig_loopholes==2, "Does not use loopholes", "Uses loopholes")),
         vig_charity = as_factor(ifelse(vig_charity==2, "Does not donate", "Donates")),
         vig_consumption = as_factor(ifelse(vig_consumption==2, "Conspicuous", "Not conspicuous")),
         Partisanship = as_factor(ifelse(partisanship_right_dummy==1, "Right-wing", "Left-wing")),
         Income = as_factor(hh_income_above_median)
         )


#relevel to get desired reference categories
vig_data_yougov <- vig_data_yougov %>%
  mutate(vig_gender = relevel(vig_gender, ref="Female"),
         vig_charity = relevel(vig_charity, ref="Donates"),
         vig_loopholes = relevel(vig_loopholes, ref="Does not use loopholes"),
         Partisanship = relevel(Partisanship, ref="Right-wing"),
         Income = relevel(Income, ref="Below median")
         )

#relabel variables for better plot display
attr(vig_data_yougov$vig_gender, "label") <- "Gender"
attr(vig_data_yougov$vig_income, "label") <- "Household income"
attr(vig_data_yougov$vig_family_bgr, "label") <- "Family bgr"
attr(vig_data_yougov$vig_hard_work, "label") <- "Work ethic"
attr(vig_data_yougov$vig_treat_workers, "label") <- "Treats workers"
attr(vig_data_yougov$vig_loopholes, "label") <- "Loopholes"
attr(vig_data_yougov$vig_charity, "label") <- "Charity"
attr(vig_data_yougov$vig_consumption, "label") <- "Consumption"
attr(vig_data_yougov$Income, "label") <- "Household Income"

#formula for estimating amces
f1 <- vig_tax ~ vig_gender + vig_income + vig_family_bgr + vig_hard_work + vig_treat_workers + vig_loopholes + vig_charity + vig_consumption

#estimate basic amce
amces_yougov <- cj(vig_data_yougov, f1, id = ~ ResponseId) %>%
  filter(feature!="Gender")
mms_yougov <- mm(vig_data_yougov, f1, id = ~ ResponseId) %>%
  filter(feature!="Gender")


#subset to only wealthy background 
vig_data_yougov_wealthy <- vig_data_yougov %>%
  filter(vig_family_bgr=="Well-off")
#estimate effect only among the susbet of vignettes with well-off family backgrounds
f2 <- vig_tax ~ vig_gender + vig_income + vig_hard_work + vig_treat_workers + vig_loopholes + vig_charity + vig_consumption
amces_wealthy_yougov <- cj(vig_data_yougov_wealthy, f2, id = ~ ResponseId) %>%
  filter(feature!="Gender")
mms_wealthy_yougov <- mm(vig_data_yougov_wealthy, f2, id = ~ ResponseId) %>%
  filter(feature!="Gender")

# data prep for anova by partisanship
vig_data_yougov_subset <- vig_data_yougov[ , c("Partisanship")] 
vig_data_yougov_complete <- vig_data_yougov[complete.cases(vig_data_yougov_subset), ]

# calculate conditional MMs
mms_cond_yougov <- cj(vig_data_yougov_complete, 
          f1,
          id = ~ ResponseId, 
          estimate = "mm", 
          by = ~ Partisanship) %>%
  filter(feature!="Gender")
diff_mms_cond_yougov <- cj(vig_data_yougov_complete, 
          f1,
          id = ~ ResponseId, 
          estimate = "mm_diff", 
          by = ~ Partisanship) %>%
  filter(feature!="Gender")

# calculate conditional amces
amces_cond_yougov <- cj(vig_data_yougov_complete, 
          f1,
          id = ~ ResponseId, 
          estimate = "amce", 
          by = ~ Partisanship) %>%
  filter(feature!="Gender")
diff_amces_cond_yougov <- cj(vig_data_yougov_complete, 
          f1,
          id = ~ ResponseId, 
          estimate = "amce_diff", 
          by = ~ Partisanship) %>%
  filter(feature!="Gender")

#prepare plots with sample-specific names so they can be used even with US data also read in (NB some object names are rewritten when both datasets are read in at once)
amces_plot_yougov <- plot(amces_yougov, legend_title=NULL, legend_pos="none")
mms_plot_yougov <- plot(mms_yougov, vline = mean(vig_data_yougov$vig_tax, na.rm=T), legend_title=NULL, legend_pos="none")
#another version for comparison between US and Denmark
mms_plot_yougov_comp <- plot(mms_yougov, vline = mean(vig_data_yougov$vig_tax, na.rm=T), legend_title=NULL, legend_pos="none", xlim=c(3,3.8)) + ggtitle("Denmark")

amces_mms_plot_yougov <- ggarrange(amces_plot_yougov, mms_plot_yougov)



#wealthy only
amces_wealthy_plot_yougov <- plot(amces_wealthy_yougov, legend_title=NULL, legend_pos="none") + ggtitle("Denmark")

#partisanship
mm_by_yougov <- cj(vig_data_yougov, f1, id = ~ ResponseId, estimate = "mm", by = ~ Partisanship) %>%
  filter(feature!="Gender")
mm_byparty_plot_yougov <- plot(mm_by_yougov, group = "Partisanship", xlim=c(2.8,3.9), legend_title = NULL) +
  plot_annotation(title="Support for taxing rich target", subtitle="Marginal means by target attributes and respondent ideology, Denmark") &
  theme(plot.title = element_text(hjust = 0.5), plot.subtitle = element_text(hjust=0.5))

amce_interactions_plot_yougov <- plot(rbind(amces_cond_yougov, diff_amces_cond_yougov), legend_title=NULL, legend_pos="none") + ggplot2::facet_wrap(~BY, ncol = 3L) + 
  plot_annotation(title="Support for taxing rich target", subtitle="Experimental results by target attributes and respondent ideology, Danish sample") &
  theme(plot.title = element_text(hjust = 0.5), plot.subtitle = element_text(hjust=0.5))


#by respondent income 
# calculate conditional amces by income
amces_inc_yougov <- cj(vig_data_yougov_complete, 
          f1,
          id = ~ ResponseId, 
          estimate = "amce", 
          by = ~ Income)  %>%
  filter(feature!="Gender")
diff_amces_inc_yougov <- cj(vig_data_yougov_complete, 
          f1,
          id = ~ ResponseId, 
          estimate = "amce_diff", 
          by = ~ Income)  %>%
  filter(feature!="Gender")

#plot results by income
amce_interactions_inc_plot_yougov <- plot(rbind(amces_inc_yougov, diff_amces_inc_yougov), legend_title=NULL, legend_pos="none") + ggplot2::facet_wrap(~BY, ncol = 3L) + 
  plot_annotation(title="Support for taxing rich target", subtitle="Results by target attributes and respondent's household income, Danish sample") &
  theme(plot.title = element_text(hjust = 0.5), plot.subtitle = element_text(hjust=0.5))

```

```{r cross-country interaction model, warning=F}

#create combined dataset
vig_data_lucid_merge <- vig_data_lucid %>%
  select(starts_with("vig_"), resp_id) %>%
  select(-"vig_timing_First Click", -"vig_timing_Last Click", -"vig_timing_Page Submit", -"vig_timing_Click Count") %>%
  mutate(country = "US",
         resp_id = as.character(resp_id),
         vig_income = as.factor(ifelse(vig_income=="$500,000", "High", "Reference"))) %>%
  rename(ResponseId = resp_id)
vig_data_yougov_merge <- vig_data_yougov %>%
  select(starts_with("vig_"), ResponseId) %>%
  mutate(country = "DK",
         ResponseId = as.character(ResponseId),
         vig_income = as.factor(ifelse(vig_income=="DKK 130,000", "High", "Reference")))
vig_data_merged <- bind_rows(vig_data_lucid_merge, vig_data_yougov_merge) %>%
  mutate(country = as.factor(country))

#relevel to get desired reference categories and drop gender coefficient
vig_data_merged <- vig_data_merged %>%
  mutate(vig_income = relevel(vig_income, ref="Reference")
         ) 

#relabel variables for better plot display
attr(vig_data_merged$vig_gender, "label") <- "Gender"
attr(vig_data_merged$vig_income, "label") <- "Household income"
attr(vig_data_merged$vig_family_bgr, "label") <- "Family bgr"
attr(vig_data_merged$vig_hard_work, "label") <- "Work ethic"
attr(vig_data_merged$vig_treat_workers, "label") <- "Treats workers"
attr(vig_data_merged$vig_loopholes, "label") <- "Loopholes"
attr(vig_data_merged$vig_charity, "label") <- "Charity"
attr(vig_data_merged$vig_consumption, "label") <- "Consumption"

# calculate conditional amces by country
amces_cond_merged <- cj(vig_data_merged, 
          f1,
          id = ~ ResponseId, 
          estimate = "amce", 
          by = ~ country) %>%
  filter(feature!="Gender")
diff_amces_cond_merged <- cj(vig_data_merged, 
          f1,
          id = ~ ResponseId, 
          estimate = "amce_diff", 
          by = ~ country) %>%
  filter(feature!="Gender")

amce_interactions_plot_merged <- plot(rbind(amces_cond_merged, diff_amces_cond_merged), legend_title=NULL, legend_pos="none") + ggplot2::facet_wrap(~BY, ncol = 3L)
```

```{r equivalence tests, eval=T, warning=F, include=F}
library(marginaleffects)
library(survey)
#equivalence tests US 

#re-estimate model in survey instead of cregg in order to run equivalence tests through marginaleffects
margmodelUS_design <- svydesign(
  ids = ~resp_id,
  wts = ~1,
  data = vig_data_lucid
)
margmodelUS_lucid <- svyglm(
  f1,
  design = margmodelUS_design
)
#look at what we've got, make sure it's same as amces from earlier
tidy(margmodelUS_lucid)

#equivalence test: can we reject that the coefficient for well off family is larger/smaller than 0.1
coef(margmodelUS_lucid)[4]
hypotheses(margmodelUS_lucid, equivalence = c(-0.1, 0.1))[4, ]
#also check what size effect can be rejected for the hard work variable which gets discussed in text a lot
#can reject hypothesis that the effect is outside the bounds -0.12 to 0.12
hypotheses(margmodelUS_lucid, equivalence = c(-0.12, 0.12))[5, ]

#contrast with what we can reject for loopholes
#range -.3 - .3 is marginal; we can reject that the effect is outside the bounds -.31, .31
hypotheses(margmodelUS_lucid, equivalence = c(-0.31,0.31))[7, ]

#and for treatment of workers we can reject effect sizes larger than 0.21
hypotheses(margmodelUS_lucid, equivalence = c(-0.22, 0.22))[6, ]

#run for whole model
US_equiv <- tidy(avg_slopes(margmodelUS_lucid, equivalence = c(-.1, .1), newdata=vig_data_lucid)) %>%
  filter(term!="vig_gender") %>%
  select(c("term", "estimate", "std.error", "p.value", "p.value.equiv")) %>%
  rename(Term = term, "US Estimate" = estimate, "US Std. Error" = std.error, "US p-value"=p.value, "US Equiv. p-value"=p.value.equiv) %>%
  mutate(
  Term = recode(Term, vig_charity = "Charity", vig_consumption = "Consumption", vig_family_bgr = "Family background", vig_hard_work = "Hard work", vig_income = "Income", vig_loopholes = "Loopholes", "vig_treat_workers" = "Treat workers")
  )


#Equivalence tests for DK
margmodelDK_design <- svydesign(
  ids = ~ResponseId,
  weights = ~1,
  data = vig_data_yougov
)
margmodelDK_yougov<- svyglm(
  f1,
  design = margmodelDK_design
)

#equivalence test: can we reject that the coefficients are outside the bounds [-.1, .1]
DK_equiv <- tidy(avg_slopes(margmodelDK_yougov, equivalence = c(-.1, .1), newdata=vig_data_yougov)) %>%
  filter(term!="vig_gender") %>%
  select(c("estimate", "std.error", "p.value", "p.value.equiv")) %>%
  rename("DK Estimate" = estimate, "DK Std. Error" = std.error, "DK p-value"=p.value, "DK Equiv. p-value"=p.value.equiv)

#merge the two sets of estimates and p-values
equiv_test <- bind_cols(US_equiv, DK_equiv)

equiv_test_table <- equiv_test %>% 
  kbl(., booktabs=T, caption = "\\label{tab:equiv_test}Equivalence test results for the main experimental effects, US and DK. Showing p-values for the null hypothesis that the causal effect is zero, and equivalence p-values for the null hypothesis that the causal effect falls outside the negligible effect interval defined as (-0.1, 0.1).") %>% 
  kable_styling(latex_options="scale_down") 


#equivalence tests for the difference between left and right in US

#use lm with interaction effects
margmodelUS_lucid_party <- lm(
  vig_tax ~ vig_gender*Partisanship + vig_income*Partisanship + vig_family_bgr*Partisanship + vig_hard_work*Partisanship + vig_treat_workers*Partisanship + vig_loopholes*Partisanship + vig_charity*Partisanship + vig_consumption*Partisanship,
  data=vig_data_lucid
)
#then marginal effects package to get amces
party_amces_US <- margmodelUS_lucid_party %>% 
  avg_slopes(
    variables = c("vig_income","vig_loopholes"),
    by = "Partisanship"
  )

#make a table of pairwise differences in these slopes
#testing whether the difference itself is outside range -.1 - 0.1
party_equiv_US_charity <- tidy(avg_comparisons(margmodelUS_lucid_party, variables = c("vig_charity"), by = "Partisanship", hypothesis = "pairwise", equivalence = c(-.1, .1))) %>%
  select("term", "estimate", "std.error", "p.value", "p.value.equiv") %>%
  mutate(term = recode(term, "Republican - Democrat" = "Charity"))
party_equiv_US_consumption <- tidy(avg_comparisons(margmodelUS_lucid_party, variables = c("vig_consumption"), by = "Partisanship", hypothesis = "pairwise", equivalence = c(-.1, .1))) %>%
  select("term", "estimate", "std.error", "p.value", "p.value.equiv") %>%
  mutate(term = recode(term, "Republican - Democrat" = "Consumption"))
party_equiv_US_family_bgr <- tidy(avg_comparisons(margmodelUS_lucid_party, variables = c("vig_family_bgr"), by = "Partisanship", hypothesis = "pairwise", equivalence = c(-.1, .1))) %>%
  select("term", "estimate", "std.error", "p.value", "p.value.equiv") %>%
  mutate(term = recode(term, "Republican - Democrat" = "Family bgr"))
party_equiv_US_hard_work <- tidy(avg_comparisons(margmodelUS_lucid_party, variables = c("vig_hard_work"), by = "Partisanship", hypothesis = "pairwise", equivalence = c(-.1, .1))) %>%
  select("term", "estimate", "std.error", "p.value", "p.value.equiv") %>%
  mutate(term = recode(term, "Republican - Democrat" = "Hard work"))
party_equiv_US_income <- tidy(avg_comparisons(margmodelUS_lucid_party, variables = c("vig_income"), by = "Partisanship", hypothesis = "pairwise", equivalence = c(-.1, .1))) %>%
  select("term", "estimate", "std.error", "p.value", "p.value.equiv") %>%
  mutate(term = recode(term, "Republican - Democrat" = "Income")) 
party_equiv_US_loopholes <- tidy(avg_comparisons(margmodelUS_lucid_party, variables = c("vig_loopholes"), by = "Partisanship", hypothesis = "pairwise", equivalence = c(-.1, .1))) %>%
  select("term", "estimate", "std.error", "p.value", "p.value.equiv") %>%
  mutate(term = recode(term, "Republican - Democrat" = "Loopholes"))
party_equiv_US_treat_workers <- tidy(avg_comparisons(margmodelUS_lucid_party, variables = c("vig_treat_workers"), by = "Partisanship", hypothesis = "pairwise", equivalence = c(-.1, .1))) %>%
  select("term", "estimate", "std.error", "p.value", "p.value.equiv") %>%
  mutate(term = recode(term, "Republican - Democrat" = "Treat workers"))

party_equiv_US <- bind_rows(party_equiv_US_charity, party_equiv_US_consumption, party_equiv_US_family_bgr, party_equiv_US_hard_work, party_equiv_US_income, party_equiv_US_loopholes, party_equiv_US_treat_workers) %>%
  rename(Term = term, "US Estimated Difference" = estimate, "US Std. Error" = std.error, "US p-value"=p.value, "US Equiv. p-value"=p.value.equiv)

#equivalence tests for the difference between left and right in DK

#use lm with interaction effects
margmodelDK_yougov_party <- lm(
  vig_tax ~ vig_gender*Partisanship + vig_income*Partisanship + vig_family_bgr*Partisanship + vig_hard_work*Partisanship + vig_treat_workers*Partisanship + vig_loopholes*Partisanship + vig_charity*Partisanship + vig_consumption*Partisanship,
  data=vig_data_yougov
)
#then marginal effects package to get amces
party_amces_DK <- margmodelDK_yougov_party %>% 
  avg_slopes(
    variables = c("vig_income","vig_loopholes"),
    by = "Partisanship"
  )

#make a table of pairwise differences in these slopes
#testing whether the difference itself is outside range -.1 - 0.1
party_equiv_DK_charity <- tidy(avg_comparisons(margmodelDK_yougov_party, variables = c("vig_charity"), by = "Partisanship", hypothesis = "pairwise", equivalence = c(-.1, .1))) %>%
  select("term", "estimate", "std.error", "p.value", "p.value.equiv") %>%
  mutate(term = recode(term, "(Right-wing) - (Left-wing)" = "Charity"))
party_equiv_DK_consumption <- tidy(avg_comparisons(margmodelDK_yougov_party, variables = c("vig_consumption"), by = "Partisanship", hypothesis = "pairwise", equivalence = c(-.1, .1))) %>%
  select("term", "estimate", "std.error", "p.value", "p.value.equiv") %>%
  mutate(term = recode(term, "(Right-wing) - (Left-wing)" = "Consumption"))
party_equiv_DK_family_bgr <- tidy(avg_comparisons(margmodelDK_yougov_party, variables = c("vig_family_bgr"), by = "Partisanship", hypothesis = "pairwise", equivalence = c(-.1, .1))) %>%
  select("term", "estimate", "std.error", "p.value", "p.value.equiv") %>%
  mutate(term = recode(term, "(Right-wing) - (Left-wing)" = "Family bgr"))
party_equiv_DK_hard_work <- tidy(avg_comparisons(margmodelDK_yougov_party, variables = c("vig_hard_work"), by = "Partisanship", hypothesis = "pairwise", equivalence = c(-.1, .1))) %>%
  select("term", "estimate", "std.error", "p.value", "p.value.equiv") %>%
  mutate(term = recode(term, "(Right-wing) - (Left-wing)" = "Hard work"))
party_equiv_DK_income <- tidy(avg_comparisons(margmodelDK_yougov_party, variables = c("vig_income"), by = "Partisanship", hypothesis = "pairwise", equivalence = c(-.1, .1))) %>%
  select("term", "estimate", "std.error", "p.value", "p.value.equiv") %>%
  mutate(term = recode(term, "(Right-wing) - (Left-wing)" = "Income")) 
party_equiv_DK_loopholes <- tidy(avg_comparisons(margmodelDK_yougov_party, variables = c("vig_loopholes"), by = "Partisanship", hypothesis = "pairwise", equivalence = c(-.1, .1))) %>%
  select("term", "estimate", "std.error", "p.value", "p.value.equiv") %>%
  mutate(term = recode(term, "(Right-wing) - (Left-wing)" = "Loopholes"))
party_equiv_DK_treat_workers <- tidy(avg_comparisons(margmodelDK_yougov_party, variables = c("vig_treat_workers"), by = "Partisanship", hypothesis = "pairwise", equivalence = c(-.1, .1))) %>%
  select("term", "estimate", "std.error", "p.value", "p.value.equiv") %>%
  mutate(term = recode(term, "(Right-wing) - (Left-wing)" = "Treat workers"))
party_equiv_DK <- bind_rows(party_equiv_DK_charity, party_equiv_DK_consumption, party_equiv_DK_family_bgr, party_equiv_DK_hard_work, party_equiv_DK_income, party_equiv_DK_loopholes, party_equiv_DK_treat_workers) %>%
  select(c(-term)) %>%
  rename("DK Estimated Difference" = estimate, "DK Std. Error" = std.error, "DK p-value"=p.value, "DK Equiv. p-value"=p.value.equiv)

party_equiv <- bind_cols(party_equiv_US, party_equiv_DK)

party_equiv_test_table <- party_equiv %>% 
  kbl(., booktabs=T, caption = "\\label{tab:party_equiv_test}Equivalence test results for the difference in experimental effects between left-wing and right-wing respondents in the US and DK. Showing p-values for the null hypothesis that the difference in causal effects is zero, and equivalence p-values for the null hypothesis that the difference in causal effects falls outside the negligible difference interval defined as (-0.1, 0.1).") %>% 
  kable_styling(latex_options="scale_down") 

### Equivalence tests of cross-national differences 

#use lm with interaction effects
margmodel_cross_national <- lm(
  vig_tax ~ vig_gender*country + vig_income*country + vig_family_bgr*country + vig_hard_work*country + vig_treat_workers*country + vig_loopholes*country + vig_charity*country + vig_consumption*country,
  data=vig_data_merged
)

#make a table of pairwise differences in these slopes
#testing whether the difference itself is outside range -.1 - 0.1
cn_equiv_charity <- tidy(avg_comparisons(margmodel_cross_national, variables = c("vig_charity"), by = "country", hypothesis = "pairwise", equivalence = c(-.1, .1))) %>%
  select("term", "estimate", "std.error", "p.value", "p.value.equiv") %>%
  mutate(term = recode(term, "DK - US" = "Charity"))
cn_equiv_consumption <- tidy(avg_comparisons(margmodel_cross_national, variables = c("vig_consumption"), by = "country", hypothesis = "pairwise", equivalence = c(-.1, .1))) %>%
  select("term", "estimate", "std.error", "p.value", "p.value.equiv") %>%
  mutate(term = recode(term, "DK - US" = "Consumption"))
cn_equiv_family_bgr <- tidy(avg_comparisons(margmodel_cross_national, variables = c("vig_family_bgr"), by = "country", hypothesis = "pairwise", equivalence = c(-.1, .1))) %>%
  select("term", "estimate", "std.error", "p.value", "p.value.equiv") %>%
  mutate(term = recode(term, "DK - US" = "Family bgr"))
cn_equiv_hard_work <- tidy(avg_comparisons(margmodel_cross_national, variables = c("vig_hard_work"), by = "country", hypothesis = "pairwise", equivalence = c(-.1, .1))) %>%
  select("term", "estimate", "std.error", "p.value", "p.value.equiv") %>%
  mutate(term = recode(term, "DK - US" = "Hard work"))
cn_equiv_income <- tidy(avg_comparisons(margmodel_cross_national, variables = c("vig_income"), by = "country", hypothesis = "pairwise", equivalence = c(-.1, .1))) %>%
  select("term", "estimate", "std.error", "p.value", "p.value.equiv") %>%
  mutate(term = recode(term, "DK - US" = "Income")) 
cn_equiv_loopholes <- tidy(avg_comparisons(margmodel_cross_national, variables = c("vig_loopholes"), by = "country", hypothesis = "pairwise", equivalence = c(-.1, .1))) %>%
  select("term", "estimate", "std.error", "p.value", "p.value.equiv") %>%
  mutate(term = recode(term, "DK - US" = "Loopholes"))
cn_equiv_treat_workers <- tidy(avg_comparisons(margmodel_cross_national, variables = c("vig_treat_workers"), by = "country", hypothesis = "pairwise", equivalence = c(-.1, .1))) %>%
  select("term", "estimate", "std.error", "p.value", "p.value.equiv") %>%
  mutate(term = recode(term, "DK - US" = "Treat workers"))

cn_equiv <- bind_rows(cn_equiv_charity, cn_equiv_consumption, cn_equiv_family_bgr, cn_equiv_hard_work, cn_equiv_income, cn_equiv_loopholes, cn_equiv_treat_workers) %>%
  rename(Term = term, "US vs. DK Estimated Difference" = estimate, "Std. Error" = std.error, "P-value"=p.value, "Equiv. p-value"=p.value.equiv)

comp_equiv_test_table <- cn_equiv %>% 
  kbl(., booktabs=T, caption = "\\label{tab:comp_equiv_test}Equivalence test results for the difference in experimental effects between respondents in the US and DK. Showing p-values for the null hypothesis that the difference in causal effects is zero, and equivalence p-values for the null hypothesis that the difference in causal effects falls outside the negligible difference interval defined as (-0.1, 0.1).") %>% 
  kable_styling(latex_options="scale_down") 

#also find out what effect can be ruled out for the largest estimated difference (treat workers)
avg_comparisons(margmodel_cross_national, variables = c("vig_hard_work"), by = "country", hypothesis = "pairwise", equivalence = c(-.12, .12))
#this means that we can reject the null that differences in effect lie outside the range (-.12 to .12) 
```

```{=tex}
\setcounter{page}{1}
\renewcommand{\thefigure}{A\arabic{figure}} \setcounter{figure}{0}
\renewcommand{\thetable}{A\arabic{table}} \setcounter{table}{0}
\setcounter{footnote}{0}
```

\newpage

\doublespacing

# Appendix A1: Detailed description of the coding scheme in Study 1

The study explored what Americans think of when they imagine the (un)deserving rich. The respondents were asked one of two sets of open-ended questions. Half of the respondents were asked two questions about rich people (presented in randomized order; randomized element in square brackets):

-   "Some people make a lot more money than others. Please imagine a person who is rich and has a good income. Now, imagine that this person [clearly has more than what they deserve]/[deserves what they have, fair and square]. Please describe what comes to mind when you think about this person."

The remaining half were asked a broader question about what considerations come to mind when they think about asking the rich to "pay their fair share":

-   "Sometimes people talk about asking the rich to "pay their fair share" in taxes. In talking to people, we've found that people think about a range of different things when they consider this. What comes to mind when you think about whether the rich "pay their fair share" in taxes?"

In addition, respondents were also asked standard survey questions regarding opportunities for upward mobility ("How much opportunity is there in America today for the average person to get ahead?" and "Some people say that people get ahead by their own hard work; others say that lucky breaks or help from other people are more important. Which do you think is most important?"). They answered one question about the level of household income at which they would consider a household rich. They also filled in the racial resentment scale, were asked to indicate how much they support various redistributive policies ("The government should do more to redistribute from the rich to the poor, even if it means raising taxes."; "High incomes should be taxed more than is currently the case."; "We should decrease government spending on social welfare programs."), and were asked a standard battery of demographic variables including partisanship and household income.

```{r data prep for category development analysis, include=F, echo=F}
#read in complete open-ended coding data, with coder-specific codes
openended <- read.csv(here("Study 1", "Study 1 open ended codes by coder.csv"))

fairshare <- openended %>% 
  filter(open_fairshare==1) %>%
  select(!starts_with("u_")) %>%
  select(!starts_with("d_")) %>%
  select(!ends_with("c3")) %>%
  select(!ends_with("c1")) %>%
  select(!ends_with("c2")) 

undeserving <- openended %>%
  filter(open_rich==1) %>%
  select(!starts_with("f_")) %>%
  select(!starts_with("d_")) %>%
  select(!ends_with("c3")) %>%
  select(!ends_with("c1")) %>%
  select(!ends_with("c2")) 

deserving <- openended %>%
  filter(open_rich==1) %>% 
  select(!starts_with("f_")) %>%
  select(!starts_with("u_")) %>%
  select(!ends_with("c3")) %>%
  select(!ends_with("c1")) %>%
  select(!ends_with("c2")) 

#what share of responses were not covered by any theme?
openended <- openended %>% 
  rowwise() %>%
  mutate(
    has_theme_deserving = sum(d_hardwork==3 | d_nohardwork==3 | d_giveback==3 | d_inherit==3 | d_modestbgr==3 | d_premise==3 | d_loopholes==3 | d_noloopholes==3 | d_highertaxes==3 | d_keepmoney==3 | d_fairtreat==3 | d_unfairtreat==3 | d_corrupt==3 | d_negative==3 | d_positive==3 | d_conspicuous==3 | d_modest==3 | d_lucky==3 | d_morethanneed==3 | d_system==3),
    has_theme_undeserving = sum(u_hardwork==3 | u_nohardwork==3 | u_giveback==3 | u_inherit==3 | u_modestbgr==3 | u_premise==3 | u_loopholes==3 | u_noloopholes==3 | u_highertaxes==3 | u_keepmoney==3 | u_fairtreat==3 | u_unfairtreat==3 | u_corrupt==3 | u_negative==3 | u_positive==3 | u_conspicuous==3 | u_modest==3 | u_lucky==3 | u_morethanneed==3 | u_system==3),
    has_theme_fairshare = sum(f_taxeshelp==3 | f_loopholes==3 | f_corporate==3 | f_highertaxes==3 | f_flattax==3 | f_keepmoney==3 | f_morethanneed==3 | f_incentives==3 | f_system==3)
  )

```

The open-ended responses were organized by major recurring themes in two stages of coding. In the first stage, the author read the open-ended responses and identified recurring themes. The themes were developed in two separate sets: one set of themes to be applied to the "deserving rich" and "undeserving rich" responses, and a separate set of themes for the "pay one's fair share in taxes" responses. Each response could be coded as including several themes. Tables A1 and A2 show the resulting themes and the language that counted toward that theme (the one exception to the procedure described above is the 'system' variable which was added at the second stage of analysis; see below).

Some themes were coded separately based on whether respondents expected that the target *possessed* the trait in question, or whether they mentioned the target did *not* possess the trait in question. This was a particularly useful approach to the "hard work" category: while the undeserving rich prompt received several responses saying that an undeserving rich person presumably "did not work hard", it also received responses arguing that even an undeserving rich person must have "worked hard" for what they had. Coding these two types of mentions separately therefore gives a more accurate view of respondents' reactions than a unified "hard work" category would. Additionally, coding separately for the presence and absence of a trait helps clarify whether traits are most prominent in their presence or absence. For example, expectations that an undeserving rich person treated their workers unfairly were more common than expectations that a deserving rich person treated their workers fairly.

The variable for "giving back" is also worth highlighting, as this category was coded only for whether the respondent mentioned some form of giving back or charity. This choice was made because nearly all mentions of giving back were phrased conditionally (for the deserving and undeserving prompt alike). Conditional phrasing included "they should still have to share with people who have less", "they should still donate money since they have an excess that they will not use", or "they should want to help others". Overall, responses that mentioned charitable giving in a conditional way tended to imply that a charitable rich person would be more deserving; this occurred to a similar extent for both prompts.

| Variable | Content | Includes mentions of| 
|:---|:------|:----------------|
| hardwork | Worked hard | Worked their way up / has a job / Successful / grew business from ground up / sense of purpose and direction / had good invention / hard earned money | 
| nothardwork | Did not work hard |	Lazy |
| giveback	| Should give back to society | Give to charity / Donate / Contribute to society / Help others / Invented something that helps others / supports the community |
| inherit	| Inherited wealth	| Rich parents / Trust fund baby / Family wealth / Family connections  / Got a job through parents / Grew up in privilege |
| modestbgr |	From modest background |	Started modestly / From poor background / Low income background / Came from modest means / Started from the bottom / Built their own wealth / Self-made |
| d_premise |	No one deserves great wealth |	Question whether it is possible to deserve wealth / Assertions that it is not possible to deserve great wealth |
| u_premise | If one has wealth it is deserved | Question whether it is possible to have something but not deserve it / Assertions that it is not possible to not deserve wealth one already has / He has it therefore he deserves it / what does it mean to not deserve what you have / not my place to say |
| loopholes	| Use loopholes |	Loopholes / Offshores / Tax avoidance |
| noloopholes |	Do not use loopholes |	Pay their taxes / Do not have offshores / Do not look for loopholes |
| highertaxes	| Should pay higher taxes | Should be taxed more than are / Should be taxed more than others / Should pay more taxes than their secretary / Pay more taxes compared to poor people / Income must be redistributed / There should be an income cap |
| keepmoney | Deserve to keep money |	Use how they see fit / Do what they want with it / Should not be punished / No one can be told what to do with their own money / Entitled to their money / Does not include repetition of “they deserve it” for this gets too close to q wording |
| fairtreat	| Treat others fairly | Treat workers fairly / Earn it without harming others / Earned it honestly / Gives fair wages / Gives good benefits |
| unfairtreat |	Treat others unfairly	 | Pay low wages / Job harms others / Step all over people / Exploitation / Takes advantage of others |
| corrupt |	Corrupt |	Fraud / Illegal means / Scam / Corrupt / Stealing |
| negative | Negative personality traits	 | Greedy / Selfish / Spoiled / Dishonest person / Unethical / Cheat  / Bad person / Don’t notice their privilege / Money-grubbing / Full of themselves / Snobby / Pretentious / Out of touch |
| positive	| Positive personality traits	| Generous / A good person / Compassionate / Caring / Understand the less fortunate / Understand working people / Humble / Has a understanding of the plight of the many |
| conspicuous |	Conspicuous consumption | Flashy / Unnecessary things / Things that are overpriced / Lavish spending |
| modest | Modest habits |	Humble / Modest about their wealth / Does not have more than they need / Does not have excess income / wealthy but not elite |
| lucky | Lucky |	Got lucky / in the right place at the right time |
| morethanneed |	Have more than they need |	More than they could spend in a lifetime / Doesn’t need all that money / Not able to use  / Abundance left sitting around / Inability to take riches with us after death /  More than they know what to do with |
| system | Systematic causes | Some people become rich because the system allows it / rich become richer |

Table: Coding scheme for open-ended reactions to (un)deserving rich people.


| Variable | Content | Includes mentions of| 
|:---|:------|:----------------|
| generic | Generic support for taxing the rich | Rich should pay their share / rich should pay more than poor / rich pay less in tax than the poor / rich currently don't pay fair share / includes comments that cannot be classified either as supportive of proportional or progressive taxes but do speak to importance of paying one's share |
| taxeshelp | Taxes help the community / others | Taxes help the poor / taxes provide services
| loopholes | Concern about use of loopholes | Accountants / offshores / loopholes / tax avoidance / tax breaks / tax deductions / capital gains tax lower than income tax |
| corporate | Concern about corporate taxes | Too low corporate taxes / large companies paying too little tax | 
| highertaxes | Explicit support for progressive / higher taxes on the rich | calls to increase taxes on rich / affirmation of progressive taxes / they do not pay enough in taxes / heavily tax the rich |
| flattax | Support for flat tax | They should pay same share / everyone should pay same rate |
| keepmoney | Deserve to keep money / pay enough in taxes | They deserve to keep the money / concerns about incentives / already pay enough / should not be punished for having more / taking significantly more is wrong / rich already pay most of the taxes | 
| morethanneed | Have more than they need | Already have enough / have too much / more than they need / can afford to pay more / their lifestyle wouldn't change |
| incentives | Concern about incentives to work/invest | shouldn't tax them to the point of disadvantage |
| system | Systematic causes | Some people become rich because the system allows it / rich become richer |

Table: Coding scheme for open-ended reactions to what it means for the rich to "pay their fair share"


In the second stage, two independent coders used the coding scheme to categorize the open-ended responses. This resulted in each response having three codes, one from each coder. As part of conversations with the second set of coders, one additional theme was added: 'system', which indicates responses that attributed agency/causality primarily to the social system rather than to individual actors.

The resulting coding scheme was evaluated for cross-coder consistency; see Tables A3-A5. These tables report both the rate at which a theme was present and the agreement between coders. The first column in each table reports whether a theme was present, where theme presence is defined as the share of responses where all three coders agreed that the response referred to the theme in question. The second column reports the share of responses for which coders unanimously agreed that a theme was not present. The third column reports the share of responses for which the coders disagreed; these were all coded as absence of the theme in the final dataset. 

The tables allow the reader to evaluate different ways to evaluate cross-coder consistency. For the purposes of this paper, I define acceptable cross-coder consistency as unanimity among three coders (either for the presence or the absence of a theme) for at least 80% of evaluated responses. In other words, the rate at which disagreement occurs among any pair of the three coders cannot exceed 20% of evaluated statements. By this criterion, most themes were coded with acceptable cross-coder consistency. However, some of the less commonly occurring themes had high ratios of coder disagreements to coder agreements of theme presence. To guard against idiosyncrasies in coder evaluations inflating the coded rate of theme occurrence, all instances of disagreement were coded as absences of the theme in the final dataset. 

In general, the themes were somewhat more reliable when categorizing responses to the (un)deserving rich than when categorizing responses to the "fair share" prompt. One category proved too unreliable to use in further analyses: this was the category "generic" (which indicated vaguely worded support for higher taxes that nonetheless did not clearly indicate support for progressive principles or higher taxes on the rich), which only achieved a cross-coder agreement (as defined above) of 49%. Qualitative consultation with the independent coders confirmed that this was a category that easily overlapped with others, as well as being difficult to apply in cases where the respondents closely mimicked the language of the prompt. As a result, the category was deemed unreliable and is not used in further analyses. All other categories had cross-coder agreement of 80% or higher and are used in the final analysis. 

Each response could be coded as corresponding to several themes, so the frequencies below are not an indicator of the share of respondents whose responses matched one or more of the themes. However, most respondents (`r round(100*(1 - sum(openended$open_rich==1 & openended$has_theme_deserving==0 & openended$has_theme_undeserving==0)/sum(openended$open_rich==1)),0)`%) who were asked about the (un)deserving rich gave a response that matched a theme for at least one of those two prompts, with `r round(100*(sum(openended$open_rich==1 & openended$has_theme_deserving==1 & openended$has_theme_undeserving==1)/sum(openended$open_rich==1)),0)`% giving a response that matched a theme both for the deserving and the undeserving prompt. For those assigned the "fair share" prompt, `r round(100*(sum(openended$open_fairshare==1 & openended$has_theme_fairshare==1)/sum(openended$open_fairshare==1)),0)`% gave a response that matched a theme. 


| Variable                     | Theme present (coders agree)                                 | Theme not present (coders agree)  | Theme not present (coders disagree) |
|:-----------------------------|:------------------------------|:---------------------------|:---------------------------|
| Hard work                    | `r sum((undeserving$u_hardwork==3))/nrow(undeserving)`     | `r sum((undeserving$u_hardwork==0))/nrow(undeserving)`  | `r sum((undeserving$u_hardwork==1 | undeserving$u_hardwork==2))/nrow(undeserving)`         |
| No hard work                 | `r sum((undeserving$u_nohardwork==3))/nrow(undeserving)`   | `r sum((undeserving$u_nohardwork==0))/nrow(undeserving)`   | `r sum((undeserving$u_nohardwork==1 | undeserving$u_nohardwork==2))/nrow(undeserving)`     |
| Give back                    | `r sum((undeserving$u_giveback==3))/nrow(undeserving)`     | `r sum((undeserving$u_giveback==0))/nrow(undeserving)`     | `r sum((undeserving$u_giveback==1 | undeserving$u_giveback==2))/nrow(undeserving)`         |
| Inheritance                  | `r sum((undeserving$u_inherit==3))/nrow(undeserving)`      | `r sum((undeserving$u_inherit==0))/nrow(undeserving)`      | `r sum((undeserving$u_inherit==1 | undeserving$u_inherit==2))/nrow(undeserving)`           |
| Modest background            | `r sum((undeserving$u_modest==3))/nrow(undeserving)`       | `r sum((undeserving$u_modest==0))/nrow(undeserving)`       | `r sum((undeserving$u_modest==1 | undeserving$u_modest==2))/nrow(undeserving)`             |
| Question the premise         | `r sum((undeserving$u_premise==3))/nrow(undeserving)`      | `r sum((undeserving$u_premise==0))/nrow(undeserving)`      | `r sum((undeserving$u_premise==1 | undeserving$u_premise==2))/nrow(undeserving)`           |
| Use loopholes                | `r sum((undeserving$u_loopholes==3))/nrow(undeserving)`    | `r sum((undeserving$u_loopholes==0))/nrow(undeserving)`    | `r sum((undeserving$u_loopholes==1 | undeserving$u_loopholes==2))/nrow(undeserving)`       |
| Do not use loopholes         | `r sum((undeserving$u_noloopholes==3))/nrow(undeserving)`  | `r sum((undeserving$u_noloopholes==0))/nrow(undeserving)`  | `r sum((undeserving$u_noloopholes==1 | undeserving$u_noloopholes==2))/nrow(undeserving)`   |
| Should pay higher taxes      | `r sum((undeserving$u_highertaxes==3))/nrow(undeserving)`  | `r sum((undeserving$u_highertaxes==0))/nrow(undeserving)`  | `r sum((undeserving$u_highertaxes==1 | undeserving$u_highertaxes==2))/nrow(undeserving)`   |
| Should be able to keep money | `r sum((undeserving$u_keepmoney==3))/nrow(undeserving)`    | `r sum((undeserving$u_keepmoney==0))/nrow(undeserving)`    | `r sum((undeserving$u_keepmoney==1 | undeserving$u_keepmoney==2))/nrow(undeserving)`       |
| Treat workers fairly         | `r sum((undeserving$u_fairtreat==3))/nrow(undeserving)`    | `r sum((undeserving$u_fairtreat==0))/nrow(undeserving)`    | `r sum((undeserving$u_fairtreat==1 | undeserving$u_fairtreat==2))/nrow(undeserving)`       |
| Treat workers unfairly       | `r sum((undeserving$u_unfairtreat==3))/nrow(undeserving)`  | `r sum((undeserving$u_unfairtreat==0))/nrow(undeserving)`  | `r sum((undeserving$u_unfairtreat==1 | undeserving$u_unfairtreat==2))/nrow(undeserving)`   |
| Corrupt                      | `r sum((undeserving$u_corrupt==3))/nrow(undeserving)`      | `r sum((undeserving$u_corrupt==0))/nrow(undeserving)`      | `r sum((undeserving$u_corrupt==1 | undeserving$u_corrupt==2))/nrow(undeserving)`           |
| Negative personality traits  | `r sum((undeserving$u_negative==3))/nrow(undeserving)`     | `r sum((undeserving$u_negative==0))/nrow(undeserving)`     | `r sum((undeserving$u_negative==1 | undeserving$u_negative==2))/nrow(undeserving)`         |
| Positive personality traits  | `r sum((undeserving$u_positive==3))/nrow(undeserving)`     | `r sum((undeserving$u_positive==0))/nrow(undeserving)`     | `r sum((undeserving$u_positive==1 | undeserving$u_positive==2))/nrow(undeserving)`         |
| Conspicuous consumption      | `r sum((undeserving$u_conspicuous==3))/nrow(undeserving)`  | `r sum((undeserving$u_conspicuous==0))/nrow(undeserving)`  | `r sum((undeserving$u_conspicuous==1 | undeserving$u_conspicuous==2))/nrow(undeserving)`   |
| Modest habits                | `r sum((undeserving$u_modest==3))/nrow(undeserving)`       | `r sum((undeserving$u_modest==0))/nrow(undeserving)`       | `r sum((undeserving$u_modest==1 | undeserving$u_modest==2))/nrow(undeserving)`             |
| Got lucky                    | `r sum((undeserving$u_lucky==3))/nrow(undeserving)`        | `r sum((undeserving$u_lucky==0))/nrow(undeserving)`        | `r sum((undeserving$u_lucky==1 | undeserving$u_lucky==2))/nrow(undeserving)`               |
| Have more than they need     | `r sum((undeserving$u_morethanneed==3))/nrow(undeserving)` | `r sum((undeserving$u_morethanneed==0))/nrow(undeserving)` | `r sum((undeserving$u_morethanneed==1 | undeserving$u_morethanneed==2))/nrow(undeserving)` |
| System made them rich        | `r sum((undeserving$u_system==3))/nrow(undeserving)`       | `r sum((undeserving$u_system==0))/nrow(undeserving)`       | `r sum((undeserving$u_system==1 | undeserving$u_system==2))/nrow(undeserving)`             |

: Frequency of occurrence and coder consistency of themes in the "undeserving rich" open-ended prompt.

| Variable                     | Theme present (coders agree)                                 | Theme not present (coders agree)  | Theme not present (coders disagree) |
|:-----------------------------|:------------------------------|:---------------------------|:---------------------------|
| Hard work                    | `r sum((deserving$d_hardwork==3))/nrow(deserving)`     | `r sum((deserving$d_hardwork==0))/nrow(deserving)`     | `r sum((deserving$d_hardwork==1 | deserving$d_hardwork==2))/nrow(deserving)`         |
| No hard work                 | `r sum((deserving$d_nohardwork==3))/nrow(deserving)`   | `r sum((deserving$d_nohardwork==0))/nrow(deserving)`   | `r sum((deserving$d_nohardwork==1 | deserving$d_nohardwork==2))/nrow(deserving)`     |
| Give back                    | `r sum((deserving$d_giveback==3))/nrow(deserving)`     | `r sum((deserving$d_giveback==0))/nrow(deserving)`     | `r sum((deserving$d_giveback==1 | deserving$d_giveback==2))/nrow(deserving)`         |
| Inheritance                  | `r sum((deserving$d_inherit==3))/nrow(deserving)`      | `r sum((deserving$d_inherit==0))/nrow(deserving)`      | `r sum((deserving$d_inherit==1 | deserving$d_inherit==2))/nrow(deserving)`           |
| Modest background            | `r sum((deserving$d_modest==3))/nrow(deserving)`       | `r sum((deserving$d_modest==0))/nrow(deserving)`       | `r sum((deserving$d_modest==1 | deserving$d_modest==2))/nrow(deserving)`             |
| Question the premise         | `r sum((deserving$d_premise==3))/nrow(deserving)`      | `r sum((deserving$d_premise==0))/nrow(deserving)`      | `r sum((deserving$d_premise==1 | deserving$d_premise==2))/nrow(deserving)`           |
| Use loopholes                | `r sum((deserving$d_loopholes==3))/nrow(deserving)`    | `r sum((deserving$d_loopholes==0))/nrow(deserving)`    | `r sum((deserving$d_loopholes==1 | deserving$d_loopholes==2))/nrow(deserving)`       |
| Do not use loopholes         | `r sum((deserving$d_noloopholes==3))/nrow(deserving)`  | `r sum((deserving$d_noloopholes==0))/nrow(deserving)`  | `r sum((deserving$d_noloopholes==1 | deserving$d_noloopholes==2))/nrow(deserving)`   |
| Should pay higher taxes      | `r sum((deserving$d_highertaxes==3))/nrow(deserving)`  | `r sum((deserving$d_highertaxes==0))/nrow(deserving)`  | `r sum((deserving$d_highertaxes==1 | deserving$d_highertaxes==2))/nrow(deserving)`   |
| Should be able to keep money | `r sum((deserving$d_keepmoney==3))/nrow(deserving)`    | `r sum((deserving$d_keepmoney==0))/nrow(deserving)`    | `r sum((deserving$d_keepmoney==1 | deserving$d_keepmoney==2))/nrow(deserving)`       |
| Treat workers fairly         | `r sum((deserving$d_fairtreat==3))/nrow(deserving)`    | `r sum((deserving$d_fairtreat==0))/nrow(deserving)`    | `r sum((deserving$d_fairtreat==1 | deserving$d_fairtreat==2))/nrow(deserving)`       |
| Treat workers unfairly       | `r sum((deserving$d_unfairtreat==3))/nrow(deserving)`  | `r sum((deserving$d_unfairtreat==0))/nrow(deserving)`  | `r sum((deserving$d_unfairtreat==1 | deserving$d_unfairtreat==2))/nrow(deserving)`   |
| Corrupt                      | `r sum((deserving$d_corrupt==3))/nrow(deserving)`      | `r sum((deserving$d_corrupt==0))/nrow(deserving)`      | `r sum((deserving$d_corrupt==1 | deserving$d_corrupt==2))/nrow(deserving)`           |
| Negative personality traits  | `r sum((deserving$d_negative==3))/nrow(deserving)`     | `r sum((deserving$d_negative==0))/nrow(deserving)`     | `r sum((deserving$d_negative==1 | deserving$d_negative==2))/nrow(deserving)`         |
| Positive personality traits  | `r sum((deserving$d_positive==3))/nrow(deserving)`     | `r sum((deserving$d_positive==0))/nrow(deserving)`     | `r sum((deserving$d_positive==1 | deserving$d_positive==2))/nrow(deserving)`         |
| Conspicuous consumption      | `r sum((deserving$d_conspicuous==3))/nrow(deserving)`  | `r sum((deserving$d_conspicuous==0))/nrow(deserving)`  | `r sum((deserving$d_conspicuous==1 | deserving$d_conspicuous==2))/nrow(deserving)`   |
| Modest habits                | `r sum((deserving$d_modest==3))/nrow(deserving)`       | `r sum((deserving$d_modest==0))/nrow(deserving)`       | `r sum((deserving$d_modest==1 | deserving$d_modest==2))/nrow(deserving)`             |
| Got lucky                    | `r sum((deserving$d_lucky==3))/nrow(deserving)`        | `r sum((deserving$d_lucky==0))/nrow(deserving)`        | `r sum((deserving$d_lucky==1 | deserving$d_lucky==2))/nrow(deserving)`               |
| Have more than they need     | `r sum((deserving$d_morethanneed==3))/nrow(deserving)` | `r sum((deserving$d_morethanneed==0))/nrow(deserving)` | `r sum((deserving$d_morethanneed==1 | deserving$d_morethanneed==2))/nrow(deserving)` |
| System made them rich        | `r sum((deserving$d_system==3))/nrow(deserving)`       | `r sum((deserving$d_system==0))/nrow(deserving)`       | `r sum((deserving$d_system==1 | deserving$d_system==2))/nrow(deserving)`             |

: Frequency of occurrence and coder consistency themes in the "deserving rich" open-ended prompt. 

| Variable                     | Theme present (coders agree)                                 | Theme not present (coders agree)  | Theme not present (coders disagree) |
|:-----------------------------|:------------------------------|:---------------------------|:---------------------------|
| Generic        | `r sum((fairshare$f_generic==3))/nrow(fairshare)`      | `r sum((fairshare$f_generic==0))/nrow(fairshare)`      | `r sum((fairshare$f_generic==1 | fairshare$f_generic==2))/nrow(fairshare)`           |
| Taxes help     | `r sum((fairshare$f_taxeshelp==3))/nrow(fairshare)`    | `r sum((fairshare$f_taxeshelp==0))/nrow(fairshare)`    | `r sum((fairshare$f_taxeshelp==1 | fairshare$f_taxeshelp==2))/nrow(fairshare)`       |
| Loopholes      | `r sum((fairshare$f_loopholes==3))/nrow(fairshare)`    | `r sum((fairshare$f_loopholes==0))/nrow(fairshare)`    | `r sum((fairshare$f_loopholes==1 | fairshare$f_loopholes==2))/nrow(fairshare)`       |
| Corporate      | `r sum((fairshare$f_corporate==3))/nrow(fairshare)`    | `r sum((fairshare$f_corporate==0))/nrow(fairshare)`    | `r sum((fairshare$f_corporate==1 | fairshare$f_corporate==2))/nrow(fairshare)`       |
| Higher taxes   | `r sum((fairshare$f_highertaxes==3))/nrow(fairshare)`  | `r sum((fairshare$f_highertaxes==0))/nrow(fairshare)`  | `r sum((fairshare$f_highertaxes==1 | fairshare$f_highertaxes==2))/nrow(fairshare)`   |
| Flat tax       | `r sum((fairshare$f_flattax==3))/nrow(fairshare)`      | `r sum((fairshare$f_flattax==0))/nrow(fairshare)`      | `r sum((fairshare$f_flattax==1 | fairshare$f_flattax==2))/nrow(fairshare)`           |
| Keep money     | `r sum((fairshare$f_keepmoney==3))/nrow(fairshare)`    | `r sum((fairshare$f_keepmoney==0))/nrow(fairshare)`    | `r sum((fairshare$f_keepmoney==1 | fairshare$f_keepmoney==2))/nrow(fairshare)`       |
| More than need | `r sum((fairshare$f_morethanneed==3))/nrow(fairshare)` | `r sum((fairshare$f_morethanneed==0))/nrow(fairshare)` | `r sum((fairshare$f_morethanneed==1 | fairshare$f_morethanneed==2))/nrow(fairshare)` |
| Incentives     | `r sum((fairshare$f_incentives==3))/nrow(fairshare)`   | `r sum((fairshare$f_incentives==0))/nrow(fairshare)`   | `r sum((fairshare$f_incentives==1 | fairshare$f_incentives==2))/nrow(fairshare)`     |
| System         | `r sum((fairshare$f_system==3))/nrow(fairshare)`       | `r sum((fairshare$f_system==0))/nrow(fairshare)`       | `r sum((fairshare$f_system==1 | fairshare$f_system==2))/nrow(fairshare)`             |

: Frequency of occurrence and coder consistency themes in the "paying one's fair share in taxes" open-ended prompt. 

# Appendix A2: Description of pilot survey experiment

## Research design

This study was exploratory, and no hypotheses were pre-registered. The study was a conjoint survey experiment, which took the form of vignettes that described hypothetical rich individuals. The rich individuals varied in: household income, source of wealth, work ethic, how they treat workers, use of tax loopholes, charitable giving, and conspicuous consumption.\footnote{Additionally, each vignette was randomly assigned to be described with male or female pronouns. Gender was not a variable of theoretical interest a priori, and results  showed no statistically significant impact of target gender on support for progressive taxation. The variable is included in statistical analyses but not reported on further.} Each treatment variable was randomly assigned within each vignette. Random assignment was also independent across vignettes within respondents, and no profile constraints were applied. An example vignette is included below, with randomized elements shown in bold. Table A6 also shows the full wording of each condition.

> "Imagine a person who has a household income of **[\$150,000 per year, which puts them in the top earning 20%] / [\$250,000 per year, which puts them in the top earning 10%] / [\$500,000 per year, which puts them in the top earning 1%]** of American households. Most of her income comes from **[a good job gotten through family connections] / [a large inheritance] / [having built a company from the ground up]**.

> In the workplace, she is **[known as a hard worker who always puts in the effort] / [not known as a hard worker, but rather has a tendency to slack off]**. At the same time, she has a reputation for **[treating workers fairly and paying them a good wage] / [treating workers unfairly and paying them very low wages]**.

> She employs an accountant who does her tax returns. She tells the accountant to **[to make use of all available tax loopholes, and to just pay the minimum taxes legally possible] / [avoid making use of tax loopholes, and to just pay the tax rates as they are]**.

> Outside of work, she **[does not give money to charities] / [regularly gives money to different charities]**. At the same time she has **[a habit of buying expensive and flashy things] / [modest habits and does not often buy expensive and flashy things]**."

| Variable         | Condition              | Full text                                                                                      |
|:--------------|:-------------------|:---------------------------|
| Household income | \$150,000              | \$150,000 per year, which puts them in the top earning 20%                                     |
|                  | \$250,000              | \$250,000 per year, which puts them in the top earning 5%                                      |
|                  | \$500,000              | \$500,000 per year, which puts them in the top earning 1%                                      |
| Source of wealth | Family connections     | a good job gotten through family connections                                                   |
|                  | Inheritance            | a large inheritance                                                                            |
|                  | Built a company        | having built a company from the ground up                                                      |
| Work ethic       | Works hard             | known as a hard worker who always puts in the effort                                           |
|                  | Does not work hard     | not known as a hard worker, but rather has a tendency to slack off                             |
| Treats workers   | Fairly                 | treating workers fairly and paying them a good wage                                            |
|                  | Unfairly               | treating workers unfairly and paying them very low wages                                       |
| Loopholes        | Uses loopholes         | to make use of all available tax loopholes, and to just pay the minimum taxes legally possible |
|                  | Does not use loopholes | to avoid making use of tax loopholes, and to just pay the tax rates as they are                |
| Charity          | Does not donate        | does not give money to charities                                                               |
|                  | Donates                | regularly gives money to different charities                                                   |
| Consumption      | Conspicuous            | the habit of buying expensive and flashy things                                                |
|                  | Modest                 | modest habits and does not often buy expensive and flashy things                               |

: Full wording of conjoint experiment conditions in pilot experiment

The outcome variable in this study was the question "What, in your opinion, would be fair when it comes to income taxes for people like him/her?". Respondents indicated their preference on a 5-point Likert scale labeled (from 1 to 5) "Reduced a lot", "Reduced a little", "Stay the same", "Increased a little", and "Increased a lot".

## Results

The study was run through the Prolific Academic survey recruitment website in July 2020 with a convenience sample of `r nrow(prolific)` adult participants who were residents of the United States.\footnote{The study was approved by  the University of Memphis IRB. It included a consent form that was approved as part of this IRB application, and which informed the participants they were participating in research. The consent form is available as part of the survey protocol in the replication materials. The study involved no deception. The participants were paid \$1.00 for participating in the study, which equaled an average payment rate of \$11.69 per hour; this rate is above Prolific Academic's required minimum hourly rate and above the federal minimum wage in the United States.} Each respondent saw three vignettes, resulting in `r nrow(vig_data_prolific)` vignette ratings. The respondents were `r round(sum(prolific$male==1, na.rm=T)*100/nrow(prolific),0)`% male, `r round(sum(prolific$white==1, na.rm=T)*100/nrow(prolific),0)`% white, `r round(sum(prolific$black==1, na.rm=T)*100/nrow(prolific),0)`% African-American, and `r round(sum(prolific$college==1, na.rm=T)*100/nrow(prolific),0)`% college-educated. The median household income was in the \$50,000-\$60,000 category; a rough estimate of the mean household income places it around \$75,000. `r round(sum(prolific$hh_income_thou==175, na.rm=T)*100/nrow(prolific),0)`% of respondents (`r round(sum(prolific$hh_income_thou==175, na.rm=T),0)` individuals) reported a household income of over \$150,000. In this study, `r round(sum(prolific$partisan_republican<4, na.rm=T)*100/nrow(prolific),0)`% of respondents identify or lean Democrat, `r round(sum(prolific$partisan_republican>4, na.rm=T)*100/nrow(prolific),0)`% identify or lean Republican, and `r round(sum(prolific$partisan_republican==4, na.rm=T)*100/nrow(prolific),0)`% are non-leaning independents.\footnote{To improve representativeness in terms of partisanship over the sample in Study 1, this study was set up to recruit an even number of Democrats, Independents, and Republicans (as self-identified in their Prolific Academic profiles). Due to a combination of a) not all participants reporting the same party identification in this survey as they had provided in their participant profiles on Prolific Academic and b) the recruited independents leaning more Democratic than Republican, the final survey was not an even partisan split, but it was nonetheless an improvement over Study 1.}

The results of the experiment show that support for taxing the rich is generally high across conditions. Across all vignette combinations, mean support for taxing the rich (the grand mean) is `r mean(vig_data_prolific$vig_tax)` (standard deviation `r sd(vig_data_prolific$vig_tax)`), meaning that on average, respondents support taxes being "increased a little". Also across all vignettes, only `r round(sum(vig_data_prolific$vig_tax<3, na.rm=T)*100/nrow(vig_data_prolific),0)`% of responses are in favor of decreasing taxes (`r round(sum(vig_data_prolific$vig_tax==2, na.rm=T)*100/nrow(vig_data_prolific),0)`% of responses for reducing taxes a little and `r round(sum(vig_data_prolific$vig_tax==1, na.rm=T)*100/nrow(vig_data_prolific),0)`% of responses in favor of reducing taxes a lot). `r round(sum(vig_data_prolific$vig_tax==3, na.rm=T)*100/nrow(vig_data_prolific),0)`% of responses recommend leaving taxes as they are.

The conjoint experiment was analyzed using the 'cregg' package in R [@leeper2020]. The results are visualized in Figure \ref{fig:cj_results}, with average marginal component effects (AMCE) in the left panel, and marginal means in the right panel. The gray line in the right panel shows the grand mean of `r mean(vig_data_prolific$vig_tax)`.

```{r mms and amces together plot prolific, fig.cap="\\label{fig:cj_results}Results from pilot conjoint experiment. Showing average marginal component effects (AMCE) on the left and marginal means on the right. Higher values of the outcome variable indicate stronger support for increasing income taxes for the target individual. The grey line in the marginal means plot is the grand mean."}
amces_mms_plot_prolific
```

There is a significant impact of the target's household income on the respondents' willingness to increase the target's income taxes. Looking at marginal means, support for increasing taxes for a household that earns \$150,000 is `r mms_prolific[mms_prolific$level=="$150,000","estimate"]` (baseline), which rises to `r mms_prolific[mms_prolific$level=="$250,000","estimate"]` (AMCE `r amces_prolific[amces_prolific$level=="$250,000","estimate"]`, p \< 0.01) for a household income of \$250,000 and `r mms_prolific[mms_prolific$level=="$500,000","estimate"]` (AMCE `r amces_prolific[amces_prolific$level=="$500,000","estimate"]`, p \< 0.01) for a household income of \$500,000. The difference between the \$250,000 and \$500,000 incomes is itself also statistically significant.

Out of the non-income variables, the only treatments with substantial and significant effects are how the target treats workers (AMCE `r amces_prolific[12,"estimate"]`, p \< 0.01) and their use of tax loopholes (AMCE `r amces_prolific[amces_prolific$level=="Uses loopholes","estimate"]`, p \< 0.01); each of these variables causes about a third of a point change on the 5-point scale of the outcome variable. Surprisingly, the estimates for the target's work ethic (AMCE `r amces_prolific[amces_prolific$level=="Does not work hard","estimate"]`, p = `r amces_prolific[amces_prolific$level=="Does not work hard","p"]`) as well as the source of their wealth (inheritance AMCE `r amces_prolific[amces_prolific$level=="Inheritance","estimate"]`, p = `r amces_prolific[amces_prolific$level=="Inheritance","p"]`; family connections AMCE `r amces_prolific[amces_prolific$level=="Family connections","estimate"]`, p = `r amces_prolific[amces_prolific$level=="Family connections","p"]`), while in the expected direction, were substantially smaller and not statistically significant at the 0.05 level. Likewise, the behaviors of charitable giving (AMCE `r amces_prolific[amces_prolific$level=="Does not donate","estimate"]`, p = `r amces_prolific[amces_prolific$level=="Does not donate","p"]`) and conspicuous consumption (AMCE `r amces_prolific[amces_prolific$level=="Conspicuous","estimate"]`, p = `r amces_prolific[amces_prolific$level=="Conspicuous","p"]`) had estimates in the expected direction, but the estimated effect sizes were substantively small and statistically insignificant.

To explore whether there were partisan differences in responses to the components of the vignette, Figure \ref{fig:cj_party} visualizes the results by respondent partisanship (leaning independents are included in partisan groups; non-leaning independents are excluded from analysis). The two left panels show AMCEs for Republicans and Democrats separately; the right-most panel visualizes the *difference* in AMCEs between Republicans and Democrats. Note that Figure \ref{fig:cj_party} shows estimated causal effects, not differences in support for taxation. Baseline support for taxation shows predictable and substantial partisan differences that persist across treatment conditions, with Republicans across the board being less likely to endorse higher income taxes for the rich. Figure \ref{fig:cj_party_mms} visually illustrates these differences in means.

```{r conjoint amce diffs plot by party prolific, fig.cap="\\label{fig:cj_party}Results from pilot conjoint experiment. Showing Average Marginal Component Effects (AMCE) by partisanship. The right-most panel shows differences in causal effects between Republicans and Democrats."}
amce_interactions_plot_prolific
```

```{r conjoint mms plot by party prolific, fig.cap="\\label{fig:cj_party_mms}Results from pilot conjoint experiment. Showing marginal means by partisanship. Larger numbers on the outcome variable indicate support for increasing the target's income taxes (1-5 scale)."}
mm_by_prolific_plot
```

Looking at differences in causal effects, we see that the two groups react similarly to most treatment conditions. Republicans react less strongly to the \$500,000 household income condition, though for both groups household income remains one of the strongest predictors of willingness to increase taxes. There is also a small difference in how Democrats and Republicans react to inheritance as a source of income; while the effect of inheritance (compared to building a company from the ground up) is insignificant for both groups, the difference between Republicans and Democrats is significant, with Democrats slightly more willing to tax income acquired from "a large inheritance". 

There were no partisan differences in reactions to the remaining variables: Democrats and Republicans react similarly and strongly to indications that a person treats their workers unfairly, and that they make use of tax loopholes to the largest extent legally possible. They are also similarly unresponsive to indicators that a person is not a hard worker, does not donate to charity, or engages in conspicuous consumption.

Finally, the results were analyzed for the potential pitfalls of conjoint experiments discussed in @abramson2022. Out of the concerns they raise, the most relevant to this study is the risk of preference cycling hiding a majority preference when a treatment feature has more than two levels which are not unambiguously ordinal. In this study, this raises the question of whether the three-level source of income feature may exhibit preference cycling. Using the random forest analysis recommended in @abramson2020, I explored the data for indications of such cycling and found none. I additionally explored heterogeneous effects across demographic characteristics and similarly did not find reasons for concern. Nonetheless, out of caution for the points raised in these articles, the follow-up studies are simplified so that each feature only has two treatment levels, eliminating the risk of preference cycling. In addition to this methodological improvement, this also allows a clearer theoretical distinction between family background and individual work ethic in the follow-up experiments.

# Appendix A3: Details for Studies 2 and 3

Tables A7 and A8 show the demographic characteristics of the Danish and American samples, respectively. The tables show the demographic breakdown of the sample, and the target breakdown for a representative sample as defined by Lucid for the United States and YouGov for Denmark, respectively. The Danish sample is representative on all targeted demographic criteria. The US sample is broadly representative, but with a slight over-representation of Hispanic respondents and a slight under-representation of white respondents.

```{r US demographics comparison table}
#demographic targets for US taken from lucid's email (saved in documentation folder); it is  more detailed than the codebook they shared
demog_names_us <- c("Male", "Female", "18-24","25-34", "35-44", "45-54", "55-64", "65+", " Less than 25k", " 25-49k", " 50-74k", " 75-99k", " 100-124k", " >125k", "Midwest", "Northeast", "South", "West", "Hispanic", "Not Hispanic", "Black", "White", "Other", "Postgraduate", "Associates/BA", "Some College", "High School", "Less than high school")
demog_sample_us <- c(sum(lucid$gender_lucid==1, na.rm=T)*100/nrow(lucid), sum(lucid$gender_lucid==2, na.rm=T)*100/nrow(lucid), sum(lucid$age_lucid<25, na.rm=T)*100/nrow(lucid), sum(lucid$age_lucid>24 & lucid$age_lucid<35, na.rm=T)*100/nrow(lucid), sum(lucid$age_lucid>34 & lucid$age_lucid<45, na.rm=T)*100/nrow(lucid), sum(lucid$age_lucid>44 & lucid$age_lucid<55, na.rm=T)*100/nrow(lucid), sum(lucid$age_lucid>54 & lucid$age_lucid<65, na.rm=T)*100/nrow(lucid), sum(lucid$age_lucid>64, na.rm=T)*100/nrow(lucid), sum(lucid$hhi_lucid<4, na.rm=T)*100/nrow(lucid), sum(lucid$hhi_lucid>3 & lucid$hhi_lucid<9, na.rm=T)*100/nrow(lucid), sum(lucid$hhi_lucid>8 & lucid$hhi_lucid<14, na.rm=T)*100/nrow(lucid), sum(lucid$hhi_lucid>13 & lucid$hhi_lucid<19, na.rm=T)*100/nrow(lucid), sum(lucid$hhi_lucid==19, na.rm=T)*100/nrow(lucid), sum(lucid$hhi_lucid>19, na.rm=T)*100/nrow(lucid), sum(lucid$region_lucid==2, na.rm=T)*100/nrow(lucid), sum(lucid$region_lucid==1, na.rm=T)*100/nrow(lucid), sum(lucid$region_lucid==3, na.rm=T)*100/nrow(lucid), sum(lucid$region_lucid==4, na.rm=T)*100/nrow(lucid), sum(lucid$hispanic_lucid_dummy==1, na.rm=T)*100/nrow(lucid), sum(lucid$hispanic_lucid_dummy==0, na.rm=T)*100/nrow(lucid), sum(lucid$ethnicity_lucid==2, na.rm=T)*100/nrow(lucid), sum(lucid$ethnicity_lucid==1, na.rm=T)*100/nrow(lucid), sum(lucid$ethnicity_lucid>3, na.rm=T)*100/nrow(lucid), sum(lucid$education_lucid>9, na.rm=T)*100/nrow(lucid), sum(lucid$education_lucid<10 & lucid$education_lucid>6, na.rm=T)*100/nrow(lucid), sum(lucid$education_lucid==6, na.rm=T)*100/nrow(lucid), sum(lucid$education_lucid==5 | lucid$education_lucid==4 | lucid$education_lucid==3, na.rm=T)*100/nrow(lucid), sum(lucid$education_lucid<3, na.rm=T)*100/nrow(lucid))
demog_national_us <- c(50,50,13,20,21,15,15,16,25,25,18,11,8,13,22,18,37,23,11,89,13,72,15,10,34,16,29,11)
demog_us <- data.frame(Variable = format(demog_names_us),
                       Sample = format(demog_sample_us, digits=3),
                       US = format(demog_national_us))
colnames(demog_us) <- c("Variable", "Percent in sample", "Percent target, US")
US_demog_table <- demog_us %>% kbl(., booktabs=T, caption = "Sample demographic characteristics, United States sample") %>% kable_styling() %>%
  footnote("United States column shows demographic targets used by Lucid.") %>%
  pack_rows("Gender", 1,2) %>%
  pack_rows("Age", 3,8) %>%
  pack_rows("HH income", 9, 14) %>%
  pack_rows("Region", 15,18) %>%
  pack_rows("Ethnicity", 19, 20) %>%
  pack_rows("Race", 21,23) %>%
  pack_rows("Education", 24,28)
US_demog_table
```

```{r DK demographics comparison table}
#demographic variables for denmark taken from YouGov document materialesammansettning
demog_names_dk <- c("Male", "Female", "18-34", "35-54", "55-69", "70+", "Capital Region", "Zealand", "Southern Denmark", "Central Denmark", "North Denmark", "Low", "Middle", "High")
demog_sample_dk <- c(sum(yougov$male==1, na.rm=T)*100/nrow(yougov), sum(yougov$male==0, na.rm=T)*100/nrow(yougov), sum(yougov$profile_age==1, na.rm=T)*100/nrow(yougov), sum(yougov$profile_age==2, na.rm=T)*100/nrow(yougov), sum(yougov$profile_age==3, na.rm=T)*100/nrow(yougov), sum(yougov$profile_age==4, na.rm=T)*100/nrow(yougov), sum(yougov$region==1, na.rm=T)*100/nrow(yougov), sum(yougov$region==2, na.rm=T)*100/nrow(yougov), sum(yougov$region==3, na.rm=T)*100/nrow(yougov), sum(yougov$region==4, na.rm=T)*100/nrow(yougov), sum(yougov$region==5, na.rm=T)*100/nrow(yougov), sum(yougov$bixdemo_db_education==1, na.rm=T)*100/nrow(yougov), sum(yougov$bixdemo_db_education==2, na.rm=T)*100/nrow(yougov), sum(yougov$bixdemo_db_education==3, na.rm=T)*100/nrow(yougov))
demog_national_dk <- c(50.6, 49.4,27.4,32.6,22.4,17.5,31.6,14.5,21.1,22.6,10.3,68.2,22.4,9.4)
demog_dk <- data.frame(Variable = format(demog_names_dk),
                       Sample = format(demog_sample_dk, digits=3),
                       Denmark = format(demog_national_dk))
DK_demog_table <- demog_dk %>% kbl(., booktabs=T, caption = "Sample demographic characteristics, Danish sample") %>% kable_styling() %>%
  footnote("Denmark column shows demographic targets used by YouGov.") %>%
  pack_rows("Gender", 1,2) %>%
  pack_rows("Age", 3,6) %>%
  pack_rows("Region", 7, 11) %>%
  pack_rows("Education", 12,14) 
DK_demog_table
```

Table A9 shows the full wording of each treatment in the vignettes used in Studies 2 and 3. An example vignette with full wording is presented in the main text of the article.

These studies were approved by the University of Memphis IRB. Study 2 included a consent form that was approved as part of the IRB application, and which informed the participants they were participating in research. The consent form is available as part of the survey protocol in the replication materials. Study 3, which was entirely run on YouGov's proprietary survey platform, did not include a separate consent form, as the IRB determined that YouGov's own informed consent procedure when recruiting participants into the respondent panel was sufficient to ensure informed consent. The study involved no deception. The participants were paid by Lucid and YouGov at rates determined by these companies; while the researcher paid the companies for the service of recruiting participants, the researcher did not directly pay any participants and had no control over the compensation level for the individual participants.

|                         | Variation 1    | Variation 2                                 |
|:---------------------|:------------------------------|:---------------------------|
|                  Gender | He             | She                                         |
|        Income (US only) | \$250,000 per year, which is more than what 9 out of 10 American households earn                                                         | \$500,000 per year, which is more than what 99 out of 100 American households earn                                                                                    |
|        Income (DK only) | 50,000 kroner gross per month, which is more than what 9 out of 10 Danes earn                                                            | 130,000 kroner gross per month, which is more than what 99 out of 100 Danes earn                                                                                      |
|       Family background | a modest family background and did not inherit money                                                                                     | a well-off family, and inherited a large amount of money                                                                                                              |
|              Work ethic | known as someone who works hard and always puts in the effort                                                                            | not known as someone who works hard, but rather has a tendency to slack off                                                                                           |
|           Treat workers | treating workers fairly and paying them a good wage                                                                                      | treating workers unfairly and paying them very low wages                                                                                                              |
|        Use of loopholes | he employs an accountant who helps him make the most use of tax loopholes, so that he pays the smallest amount of taxes legally possible | even though he could employ an accountant to help him make use of tax loopholes and pay less taxes, he chooses not to do this and just pays the tax rates as they are |
|       Charitable giving | regularly gives money to different charities                                                                                             | does not give money to charities                                                                                                                                      |
| Conspicuous consumption | modest habits and does not often buy expensive and flashy things                                                                         | the habit of buying expensive and flashy things for himself                                                                                                           |

: Full wording of conjoint experiment conditions in studies 2 and 3

# Appendix A4: Additional pre-registered analysis of the 'hard work' variable

The pre-registration plan for studies 2 and 3 specified a second analysis of the 'hard work' treatment variable. This was pre-specified due to a concern that a combination of a poor family background and poor work ethic may send contradictory/confusing signals about how the target individual has acquired a high income. Therefore, the impact of the work ethic variable was to be additionally estimated only among vignettes where the target is described as being from a wealthy background. A significant effect of 'hard work' found when restricting the analysis to rich targets would be considered evidence in support of the hypothesis that perceptions of "hard work" matter.

```{r amces interaction plot wealthy, warning=F, fig.cap="\\label{fig:wealth_only_plot}Results from conjoint experiments in Studies 2 and 3. Showing pre-registered analysis when subsetting to only vignettes where the target was from a well-off family background."}
amces_mms_wealthy_plot <- (amces_wealthy_plot_lucid + amces_wealthy_plot_yougov) + 
  plot_annotation(title="Support for taxing rich target", subtitle="Experimental results, subset of targets from wealthy backgrounds") &
  theme(plot.title = element_text(hjust = 0.5), plot.subtitle = element_text(hjust=0.5))
amces_mms_wealthy_plot
```

Figure \ref{fig:wealth_only_plot} reproduces the conjoint analyses in studies 2 and 3 with both datasets subset only to rankings of targets that were described as being from a well-off family background. In both studies, support for increasing taxes on the target from a well-off family is not statistically significantly higher if the target is described as "not working hard". Therefore, no evidence of a significant effect by which hard work justifies lower taxes was found in this pre-registered analysis.

# Appendix A5: Equivalence tests 

Tables \ref{tab:equiv_test}-\ref{tab:party_equiv_test} show equivalence tests for the main experimental findings in the US and Denmark (Table \ref{tab:equiv_test}), as well as for the interaction analysis comparing results across countries (Table \ref{tab:comp_equiv_test}) and across political leaning within countries (Table \ref{tab:party_equiv_test}). The implementation of these tests relies on instruction materials made publicly available by @heiss2023 and @rainey2023.

Equivalence tests are a way to explore whether findings fall into a sufficiently narrow range around zero so as to be considered negligible. The null hypothesis in an equivalence test is that the coefficient falls *outside* a researcher-defined range of negligible effects. Low p-values indicate that data is inconsistent with the null hypothesis, or in other words that data is consistent with the effect size being negligible. High p-values indicate that data is inconsistent with the effect size being negligible.

In all analyses in this section, I have chosen to specify an effect size in the range (-0.1 to 0.1) as negligible. For the interaction effects, I use the same negligible range; *differences* in effects that are smaller than (-0.1 to 0.1) are considered negligible. 

```{r equiv_test, warning=F}
equiv_test_table
```

```{r comp_equiv_test, warning=F}
comp_equiv_test_table
```

```{r party_equiv_test, warning=F}
party_equiv_test_table
```

# Appendix A6: Heterogeneous effects by respondent income

Figures \ref{fig:amce_by_resp_inc_US} and \ref{fig:amce_by_resp_inc_DK} show an exploratory analysis of differences in treatment effects by respondent's household income, separately for the United States and Denmark. Respondents are divided into two groups: household incomes above the sample median, and household incomes at or below the sample median. Results show similar patterns across respondent income groups. 

```{r amce by respondent income in US, warning=F, fig.cap="\\label{fig:amce_by_resp_inc_US}AMCE by target attributes and respondent household income."}
amce_interactions_inc_plot_lucid
```

```{r amce by respondent income in DK, warning=F, fig.cap="\\label{fig:amce_by_resp_inc_DK}AMCE by target attributes and respondent household income."}
amce_interactions_inc_plot_yougov
```

# Appendix A7: Comparison of marginal means across US and Danish results

Figure \ref{fig:mm_comps_plot} displays the marginal means for the United States and Denmark side by side and on a 3.0 to 4.0 axis to visualize cross-national differences in underlying support for progressive taxes. The national differences in marginal means co-exist with similar size causal effects in the conjoint experiment, meaning that the national differences persist in each treatment condition, and that reactions to the treatments in the vignettes are similar across countries.

```{r mms and amces together plot yougov, warning=F, fig.cap="\\label{fig:mm_comps_plot}Results from conjoint experiments in Studies 2 and 3. Showing marginal means for the United States on the left, and Denmark on the right. Higher values of the outcome variable indicate stronger support for increasing income taxes for the target individual. The grey lines in the marginal means plots are the grand mean for each sample."}
mms_comp_plot <- (mms_plot_lucid_comp + mms_plot_yougov_comp) + 
  plot_annotation(title="Support for taxing rich target", subtitle="Marginal means by target attribute and respondent country") &
  theme(plot.title = element_text(hjust = 0.5), plot.subtitle = element_text(hjust=0.5))
mms_comp_plot
```

# Appendix A8: Differences in marginal means by party

Figure \ref{fig:mm_by_country} shows differences in marginal means by party and country. As the visualization shows, overall support for increasing the income taxes of the hypothetical targets is higher in the United States than in Denmark. Differences between Danish and American respondents, and left-wing and right-wing respondents, remain significant in all treatment conditions, while reactions to experimental treatments are similar across groups.

```{r marginal means by party and country, warning=F, fig.cap="\\label{fig:mm_by_country}Marginal means by treatment condition, displayed separately by political affiliation and country."}
mms_comp_byparty_plot <- (mm_byparty_plot_yougov + mm_byparty_plot_us) + 
  plot_annotation(title="Support for taxing rich target", subtitle="Marginal means by target attribute, and respondent political affiliation") &
  theme(plot.title = element_text(hjust = 0.5), plot.subtitle = element_text(hjust=0.5))
mms_comp_byparty_plot
```



\newpage

# References {.unnumbered}

::: {#refs}
:::